Application Project Umsatzprognose Bäckerei

Management Summary

In dieser Projektarbeit werden Prognosemodelle entwickelt. Wir wollen damit für eine Bäckereifiliale den täglichen Umsatz pro Warengruppe schätzen.

Als Datenbasis stehen uns die historischen Umsätze für diese Filiale zur Verfügung. Den Zeitraum 2015 bis 2017 nutzen wir als Trainingsdaten für unsere Modelle. Die Prognosegüte bewerten wir dann anhand der 2018er Daten. Wir kennen die täglichen Umsätze für fünf Warengruppen: (1) Brot, (2) Brötchen, (3) Croissants, (4) Konditorei und (5) Kuchen.

Neben den Umsatzdaten binden wir Wetterdaten (Temperatur, Wind und Bewölkung), Veranstaltungsdaten (Kieler Woche) und weitere Einflussfaktoren (Feiertage, Ferien) in die Modellierung ein.

Wir testen Modelle aus insgesamt 5 verschiedenen Bereichen: Naive Modelle, die auf einfache Heuristiken zurück greifen, lineare Regressionsmodelle, Entscheidungsbäume, Support Vector Machines und Multilayer Perceptrons. Als sechstes Modell betrachten wir ein Ensemble, gebildet aus dem Mittelwert dieser Modelle.

Für die Bewertung der Modelle konzentrieren wir uns auf drei Gütekennzahlen: Die mittlere relative Abweichung (MPE) gibt uns Anhaltspunkte, ob ein Modell den Umsatz systematisch zu hoch oder zu niedrig schätzt. Solche Abweichungen können jedoch einfach mithilfe eines Offsets korrigiert werden. Ausschlaggebend ist der umsatzgewichtete Absolutwert der relativen Abweichung (WAPE) als Hauptkriterium für die Treffsicherheit eines Schätzers. Und daneben spielt die relative quadratische Abweichung eine Rolle bei der Bewertung der Prognosegüte, die besonders starke Schätzfehler misst und bewertet, die in der Praxis großen Einfluss auf den Gewinn / Verlust der Filiale haben.

Die verschiedenen Modelle schneiden für die einzelnen Warengruppe unterschiedlich ab. Für die Warengruppen 1 und 4 hat das Ensemble die Nase vorn. Aber auch jeweils ein Multilayer Perceptron, ein naives und ein lineares Modell liefert die besten Schätzwerte für die Warengruppen 2, 3 bzw. 5. Es gibt also kein klares Gewinnermodell.

Die besten Ergebnisse erzielen wir für die Warengruppen 2 (Brötchen) und 5 (Kuchen), die gleichzeitig die umsatzstärksten Warengruppen darstellen. Bei der Schätzung des täglichen Brötchen-Umsatzes liegen wir mit unserem Modell im Durchschnitt gut 10% daneben. Das ist unter Berücksichtigung der verwendeten Daten ein sehr gutes Ergebnis. Für die übrigen Warengruppen gibt es noch Verbesserungsbedarf. Möglicherweise kann man insbesondere die komplexen Modelle (Support Vector Machines und Multilayer Perceptrons) noch weiter verfeinern. Dafür fehlt uns jedoch die Erfahrung und hier ging es in erster Linie um die Anwendung dieser Modelle.

1 Allgemeine Projektinformationen

1.1 Ausgangslage

Die Bestellung von Bäckereien ist häufig noch ein manueller und zeitaufwändiger Prozess, der auf adjustierten Vorwochenwerten basiert. Eine systematische Planung unter Einbeziehung von Mustern findet nur eingeschränkt statt.

1.2 Zielsetzung

Wir testen verschiedene einfache und komplexe Modelle und bedienen uns dabei an Techniken aus den Bereichen Statistik, Machine Learning und Deep Learning. Möglicherweise finden wir ein Verfahren, dass den anderen überlegen ist und die beste Prognosegüte für alle Warengruppen aufweist.

Andererseits kann es sich herausstellen, dass das Verhalten der Warengruppen zu unterschiedlich ist und wir verschiedene Techniken für verschiedene Warengruppen benötigen.

In jedem Fall werden Prognosemodelle entworfen, die Bäckereien eine bessere Planungsgrundlage auf Warengruppenebene bieteen sollen.

Lösungsansatz

Mit Hilfe von verschiedenen Daten und Einflussfaktoren sollen die Umsätze je Warengruppe prognostiziert werden.

Abhängige / zu prognostizierende Variable:

  • Umsatzdaten

Unabhängige / beeinflussende Variablen:

  • Wetterdaten,
  • Veranstaltungsdaten,
  • Wochentage,
  • Feiertage (sowie Feiertage inkl. Brückentage),
  • Ferienzeiten
  • Jahreszeiten

1.3 Datenbasis

Untersucht werden Daten für die Jahre 2013 bis 2019. Es liegen für diesen Zeitraum als Rohdaten drei Datensätze vor:

2 Datenexploration

2.2 Überprüfung der Datenstrukturen

  • Datensatz Beispieldaten
## Classes 'spec_tbl_df', 'tbl_df', 'tbl' and 'data.frame': 11164 obs. of  3 variables:
##  $ Datum      : Date, format: "2013-07-01" "2013-07-02" ...
##  $ Warengruppe: num  1 1 1 1 1 1 1 1 1 1 ...
##  $ Umsatz     : num  149 160 112 169 171 ...
##  - attr(*, "spec")=
##   .. cols(
##   ..   Datum = col_date(format = ""),
##   ..   Warengruppe = col_double(),
##   ..   Umsatz = col_double()
##   .. )
## Observations: 11,164
## Variables: 3
## $ Datum       <date> 2013-07-01, 2013-07-02, 2013-07-03, 2013-07-04, 2...
## $ Warengruppe <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,...
## $ Umsatz      <dbl> 148.82835, 159.79376, 111.88559, 168.86494, 171.28...
## [1] "double"
## [1] "2019-07-30"
## [1] 1 6
## [1]    7.051201 1879.461831
## # A tibble: 6 x 3
##   Datum      Warengruppe Umsatz
##   <date>           <dbl>  <dbl>
## 1 2013-07-01           1   149.
## 2 2013-07-02           1   160.
## 3 2013-07-03           1   112.
## 4 2013-07-04           1   169.
## 5 2013-07-05           1   171.
## 6 2013-07-06           1   175.
## # A tibble: 6 x 3
##   Datum      Warengruppe Umsatz
##   <date>           <dbl>  <dbl>
## 1 2018-12-21           6   51.8
## 2 2018-12-22           6   66.7
## 3 2018-12-23           6   50.0
## 4 2018-12-24           6   46.1
## 5 2018-12-27           6   51.6
## 6 2018-12-28           6   35.2

Der Datensatz Beispieldaten ist ein Dataframe, enthält 11164 Zeilen und 3 Variablen:

  • Datum (date)
  • Warengruppe (int) mit den Warengruppen 1 - 6
  • Umsatz (dbl) mit Werten zwischen 7.05 und 1879.46.

Umsätze werden jeweils 5 mit Nachkommastellen angezeigt. Hier wird später eine Änderung vorgenommen und die Variable auf zwei Nachkommastellen gerundet.

  • Datensatz KiWo
## Classes 'spec_tbl_df', 'tbl_df', 'tbl' and 'data.frame': 72 obs. of  2 variables:
##  $ Datum      : Date, format: "2012-06-16" "2012-06-17" ...
##  $ KielerWoche: num  1 1 1 1 1 1 1 1 1 1 ...
##  - attr(*, "spec")=
##   .. cols(
##   ..   Datum = col_date(format = ""),
##   ..   KielerWoche = col_double()
##   .. )
## Observations: 72
## Variables: 2
## $ Datum       <date> 2012-06-16, 2012-06-17, 2012-06-18, 2012-06-19, 2...
## $ KielerWoche <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,...
## [1] FALSE
## [1] TRUE

Der Datensatz KiWo enthält 71 Zeilen und die beiden Variablen Datum (date) und KielerWoche (int), wobei die einzige Ausprägung der Variablen KielerWoche die Ziffer 1 ist. Anhand der Daten der einzelnen Daten erkennt man, dass der Datensatz nur solche Daten enthält, an denen tatsächlich die Kieler Woche in dem jeweiligen Jahr stattgefunden hat.

  • Datensatz Wetter
## Classes 'spec_tbl_df', 'tbl_df', 'tbl' and 'data.frame': 2601 obs. of  5 variables:
##  $ Datum              : Date, format: "2012-01-01" "2012-01-02" ...
##  $ Bewoelkung         : num  8 7 8 4 6 3 7 7 8 6 ...
##  $ Temperatur         : num  9.82 7.44 5.54 5.69 5.3 ...
##  $ Windgeschwindigkeit: num  14 12 18 19 23 10 14 10 12 10 ...
##  $ Wettercode         : num  58 NA 63 80 80 NA 61 80 61 NA ...
##  - attr(*, "spec")=
##   .. cols(
##   ..   Datum = col_date(format = ""),
##   ..   Bewoelkung = col_double(),
##   ..   Temperatur = col_double(),
##   ..   Windgeschwindigkeit = col_double(),
##   ..   Wettercode = col_double()
##   .. )
## Observations: 2,601
## Variables: 5
## $ Datum               <date> 2012-01-01, 2012-01-02, 2012-01-03, 2012-...
## $ Bewoelkung          <dbl> 8, 7, 8, 4, 6, 3, 7, 7, 8, 6, 6, 7, 2, 3, ...
## $ Temperatur          <dbl> 9.825000, 7.437500, 5.537500, 5.687500, 5....
## $ Windgeschwindigkeit <dbl> 14, 12, 18, 19, 23, 10, 14, 10, 12, 10, 16...
## $ Wettercode          <dbl> 58, NA, 63, 80, 80, NA, 61, 80, 61, NA, 51...
## [1] 0 8
## [1] -10.25000  32.67143
## [1]  3 35
## [1]  0 95

Der Datensatz Wetter enthält 2601 Zeilen und fünf Variablen:

  • Datum (date)
  • Bewoelkung (int) mit Werte von 0 bis 8
  • Temperatur (dbl) mit Werten zwischen -10.25 und 32.67 Grad Celsius
  • Windgeschwindigkeit (int) mit Werten zwischen 3 und 35 Knoten
  • Wettercode (int) mit Werten zwischen 0 und 95, wobei die einzelnen Wettercodes einer bestimmten Wettererscheinung oder einem bestimmten Wetterzustand entsprechen.

Weitere Informationen zu den einzelnen Variablen des Datensatzes Wetter und ihrer Interpretation können der privaten Webseite Seewetter Kiel entnommen werden.

Alle Datensätze enthalten die Variable Datum. Folglich können die einzelnen Datensätze später über diese Variable vereinigt werden.

2.3 Überprüfung des Anfangs- und Endzeitpunkt der Datumsattribute in den Datensätzen

## [1] "2013-07-01" "2019-07-30"
## [1] "2012-06-16" "2019-06-30"
## [1] "2012-01-01" "2019-08-01"
  • Die Daten des Datensatzes Beispieldaten reichen vom 01.07.2013 bis zum 30.07.2019.
  • Die Daten des Datensatzes KiWo reichen vom 16.06.2012 bis zum 30.06.2019.
  • Die Daten des Datensatzes Wetter reichen vom 01.01.2012 bis zum 01.08.2019.

2.4 Überprüfung der Datensätze auf fehlende Werte

Überprüfung auf “klassische” fehlende Werte (NA)

Zunächst einmal wird geprüft, welche klassischen fehlenden Werte (NA) in den einzelnen Datensätzen vorhanden sind:

## [1] 0
## [1] 0
## [1] 679
## [1] 0
## [1] 10
## [1] 0
## [1] 0
## [1] 669
  • Der Datensatz Beispieldaten enthält keine fehlenden Werte.
  • Der Datensatz KiWo enthält keine fehlenden Werte.
  • Der Datensatz Wetter enthält 679 fehlende Werte, davon 10 in der Spalte “Bewoelkung”, 669 in der Spalte “Wettercode”.

2.5 Überprüfung des Datensatzes auf Vollständigkeit

In In einem weiteren Schritt wird geprüft, ob die Anzahl der Zeilen pro Jahr stimmt.

In den Jahren 2014, 2015, 2017 und 2018, die vollständig vorliegen, müssten es je Warengruppe 365 Zeilen sein, im Schaltjahr 2016 366. Für das Jahr 2013, für das Daten erst ab dem 01.07.2013 zur Verfügung stehen, entsprechend 183 und für das unvollständige Jahr 2019 müssten 210 Datensätze vorliegen. Insgesamt müssten für jede Warengruppe demnach 2219 Zeilen vorhanden sein.

## # A tibble: 1 x 1
##       n
##   <int>
## 1  2174
## # A tibble: 1 x 1
##       n
##   <int>
## 1  2174
## # A tibble: 1 x 1
##       n
##   <int>
## 1  2174
## # A tibble: 1 x 1
##       n
##   <int>
## 1  2120
## # A tibble: 1 x 1
##       n
##   <int>
## 1  2174

Es fehlen bei allen Warengruppen Datensätze. Bei den Warengruppen 1,2, 3 und 5 fallen ca. 70% der fehlenden Daten auf Feiertage (insb. Karfreitag, Tag der Arbeit und 1. und 2. Weihnachtsfeiertag). Bei Warengruppe 4 sind es ca. 30%. Weitere ~30% der fehlenden Daten der Warengruppe 4 liegen in den Sommermonaten Juni, Juli, August. Eine Möglichkeit wäre, dass die Kühlung ausgefallen ist / einen Defekt hatte und demzufolge keine Konditoreiwaren angeboten wurden. Eine andere Möglichkeit wäre, dass bei sehr trockenem, warmen Wetter der Verkauf von Konditoreiwaren in der Regel ein Minusgeschäft ist und daher das Sortiment temporär/tageweise verkleinert wird. Auffällig ist, dass die Anzahl der fehlenden Werte pro Jahr abnehmend ist und sich insbesondere in den Jahren 2013 und 2018 mehrheitlich auf Feiertage beschränkt.

Untersucht man die einzelnen Jahre genauer, ergibt sich folgendes Bild:

## # A tibble: 1 x 1
##       n
##   <int>
## 1   181
## # A tibble: 1 x 1
##       n
##   <int>
## 1   181
## # A tibble: 1 x 1
##       n
##   <int>
## 1   181
## # A tibble: 1 x 1
##       n
##   <int>
## 1   165
## # A tibble: 1 x 1
##       n
##   <int>
## 1   181
## # A tibble: 1 x 1
##       n
##   <int>
## 1   357
## # A tibble: 1 x 1
##       n
##   <int>
## 1   357
## # A tibble: 1 x 1
##       n
##   <int>
## 1   357
## # A tibble: 1 x 1
##       n
##   <int>
## 1   334
## # A tibble: 1 x 1
##       n
##   <int>
## 1   357
## # A tibble: 1 x 1
##       n
##   <int>
## 1   360
## # A tibble: 1 x 1
##       n
##   <int>
## 1   360
## # A tibble: 1 x 1
##       n
##   <int>
## 1   360
## # A tibble: 1 x 1
##       n
##   <int>
## 1   350
## # A tibble: 1 x 1
##       n
##   <int>
## 1   360
## # A tibble: 1 x 1
##       n
##   <int>
## 1   356
## # A tibble: 1 x 1
##       n
##   <int>
## 1   356
## # A tibble: 1 x 1
##       n
##   <int>
## 1   356
## # A tibble: 1 x 1
##       n
##   <int>
## 1   352
## # A tibble: 1 x 1
##       n
##   <int>
## 1   356
## # A tibble: 1 x 1
##       n
##   <int>
## 1   357
## # A tibble: 1 x 1
##       n
##   <int>
## 1   357
## # A tibble: 1 x 1
##       n
##   <int>
## 1   357
## # A tibble: 1 x 1
##       n
##   <int>
## 1   357
## # A tibble: 1 x 1
##       n
##   <int>
## 1   357
## # A tibble: 1 x 1
##       n
##   <int>
## 1   358
## # A tibble: 1 x 1
##       n
##   <int>
## 1   358
## # A tibble: 1 x 1
##       n
##   <int>
## 1   358
## # A tibble: 1 x 1
##       n
##   <int>
## 1   357
## # A tibble: 1 x 1
##       n
##   <int>
## 1   358
## # A tibble: 1 x 1
##       n
##   <int>
## 1   205
## # A tibble: 1 x 1
##       n
##   <int>
## 1   205
## # A tibble: 1 x 1
##       n
##   <int>
## 1   205
## # A tibble: 1 x 1
##       n
##   <int>
## 1   205
## # A tibble: 1 x 1
##       n
##   <int>
## 1   205

Je Warengruppe und Jahr fehlen unterschiedliche viele Datensätze.

2.6 Überprüfung der Datensätze auf Ausreißer

Ein Ausreißer ist ein Wert, der außerhalb der üblichen Struktur einer Verteilung liegt. Zunächst wird in einem ersten Schritt mittels einer Visualisierung in Form von boxplots überprüft, ob die einzelnen Datensätze überhaupt Ausreißer enthalten.

Ein Boxplot zeigt uns den Median (dicke Linie) sowie das untere und obere Quartil (als Box). Der Abstand von unterem zu oberem Quartil (interquartile range: IQR) wird standardmäßig mit 1.5 multipliziert. Und genau über die auf diese Art ermittelte Spannweite erstrecken sich die sogenannten whiskers maximal, wobei die whiskers unten und oben an der Box ansetzen. Gibt es darüber hinaus noch Werte, die weiter außerhalb liegen, werden diese als Ausreißer durch Punkte gekennzeichnet.

Die Überprüfung wird begonnen mit dem Datensatz Beispieldaten:

##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##    7.051   97.787  165.494  208.308  282.592 1879.462

Das Attribut Umsatz enthält zahlreiche Ausreißer. Mit bloßem Auge ist nicht zu erkennen, wie viele Ausreißer es genau sind. Die Ausreißer werden also in einem 2. Schritt genauer betrachtet, um die genaue Anzahl der Ausreißer zu ermitteln. Statistiker haben viele Verfahren entwickelt, um auseinanderzuhalten, was man als Ausreißer bezeichnen sollte, und was nicht.

Wir verwenden - wie bereits erwähnt - die Standardeinstellung, die aus einer Definition von John W. Tukey stammt: Sie definiert einen Ausreißer als einen Punkt, der mehr als \[1,5 * IQR\] vom unteren bzw. oberen Quartil abweicht. Anders gesagt liegen untere Ausreißer unterhalb

\[Q_1 - 1,5 * IQR\] und obere Ausreißer oberhalb

\[Q_3 + 1.5 * IQR\]

Vereinfachend untersuchen wir nun die Umsatzvariable insgesamt auf Ausreißer, wobei wir zunächst nicht nach Warengruppen trennen:

##      75% 
## 559.7999
## # A tibble: 1 x 1
##       n
##   <int>
## 1   348

Die obere Grenze für Ausreißer liegt demzufolge bei 559,80€ (gerundet). Es gibt insgesamt 348 Ausreißer in der Variable Umsatz. In einem 3. Schritt betrachten wir, an welchen Daten diese Ausreißer auftreten und ob Muster erkennbar sind (z. B. überproportional hohe Umsätze an Ostern oder anderen Feiertagen, in den Ferien, während der Kieler Woche o. Ä.):

## # A tibble: 348 x 3
##    Datum      Umsatz Warengruppe
##    <date>      <dbl>       <dbl>
##  1 2013-07-06   632.           2
##  2 2013-07-07   695.           2
##  3 2013-07-09   586.           2
##  4 2013-07-10   567.           2
##  5 2013-07-11   569.           2
##  6 2013-07-12   600.           2
##  7 2013-07-13   747.           2
##  8 2013-07-14   777.           2
##  9 2013-07-15   597.           2
## 10 2013-07-17   628.           2
## # ... with 338 more rows
## # A tibble: 348 x 3
##    Datum      Umsatz Warengruppe
##    <date>      <dbl>       <dbl>
##  1 2014-12-31  1879.           5
##  2 2015-12-31  1870.           5
##  3 2016-12-31  1705.           5
##  4 2018-12-31  1668.           5
##  5 2013-12-31  1626.           5
##  6 2017-12-31  1432.           5
##  7 2014-05-05  1203.           2
##  8 2013-08-03   931.           2
##  9 2014-08-09   875.           2
## 10 2013-07-28   872.           2
## # ... with 338 more rows
## # A tibble: 4 x 3
##   Datum      Umsatz Warengruppe
##   <date>      <dbl>       <dbl>
## 1 2018-12-31   264.           1
## 2 2018-12-31   618.           2
## 3 2018-12-31   255.           3
## 4 2018-12-31  1668.           5

Erste Erkenntnisse (nach Jahren sortiert):

2013

  • Eine erste Ausreißerperiode ist - mit zwei Ausnahmetagen (Mo, 08.07.; Di, 16.07.) - in dem Zeitraum vom 06.07.2013 (Samstag) bis zum 04.08.2013 (Sonntag) zu beaobachten. Vergleicht man diese Periode mit den Ferienzeiten der verschiedenen Bundesländer im Jahr 2013, so fällt auf, dass insbesondere die für den Tourismus in Schleswig-Holstein relevanten Bundesländer Hessen, Niedersaschsen, Rheinland-Pfalz, sowie teilweise Nordrhein-Westfalen (ab. 22.07.) in diesem Zeitraum Ferien hatten. Weiterhin lagen auch die Ferien der Berliner und der Schleswig-Holsteiner selbst sowie die der Bayern teilweise in diesem Zeitraum. Die Vermutung liegt insofern nahe, dass die Sommerferien einen signifikanten Einfluss auf die Höhe des Umsatzes der betrachtenen Filiale haben.
  • Nach dieser wirklich sichtbaren, anhaltenden Periode von überproportional hohen Umsätzen folgt eine Phase - beginnend am Samstag, 10.08.2013 -, in der ausschließlich an den beiden Wochenendtagen Ausreißer-Umsätze zu beobachten sind. Diese Phase endet am 08.09.2013 (Ausnahme in dieser Phase ist So, 01.09.).
  • Nach dieser Wochenend-Ausreißerphase wird es erkennbar unregelmäßiger:
    • vereinzelt gibt es weiterhin Ausreißer an Wochenendtagen (z. B. am So, 28.09.; So, 17.11.; So, 24.11.; 01.12.; 25.12.)
    • auch an einzelnen Feiertagen / besonderen Ereignissen sind die Umsätze überproportional stark (03.10. (Tag der Deutschein Einheit); 31.12. (Silvester)).
    • die Herbst- und Winterferien sowie Weihnachten bzw. die Weihnachtsfeiertage scheinen insofern keinen signifikanten Einfluss auf die Umsätze der Bäckerei zu haben.
  • Insgesamt gibt es im Jahr 2013 zwei Tage (So, 11.08. und Di, 31.12.), an denen zwei Warengruppen Ausreißer sind (jeweils Warengruppen 2 + 5).

2014

  • Das Jahr 2014 beginnt strukturell so wie das Vorjahr geendet hat: unregelmäßig. Vereinzelt gibt es Ausreißer an Wochenendtagen (So, 12.01.; jeweils der Sonntag in der Zeit vom 09.02. - 09.03.; Sa, 29.03.; So, 06.04.).
  • Ab Sa, 12.04. bis Ende April am So, 27.04. sind jeweils beide Wochenendtage überproportional stark (Anmerkung: Ferienzeit in vielen relevanten Bundesländern); auch an Ostern (Karfreitag 18.04., Ostersonntag 20.04. sowie Ostermontag 21.04.) sind starke Umsatz-Effekte zu beobachten.
  • Ein ungewöhnlich hoher Umsatz ist am Montag, 05.05.2014 zu beobachten; es ist der höchste Umsatz im gesamten Zeitraum; ansonsten gibt es an den Sonntagen 18.05 und 25.05. Ausreißer sowie an Christi Himmelfaht (29.05.).
  • Im Zeitraum vom 31.05. bis 29.06. erstrecken sich die Ausreißer wiederum über beide Wochentage; hinzu kommt in diesem Zeitraum ein (eingeschränkter) Effekt der Kieler Woche (Ausreißer am Do, 26.06. und Fr, 27.06.).
  • Im Juli sind am Sa, 05.07. sowie von Fr, 11.07. - So, 13.07 die “üblichen” Wochenendeffekte zu beobachten.
  • Im Zeitraum vom 17.07. - 31.08 - also in einem Zeitraum von ca. 6 Wochen - jeden Tag Ausreißer zu verzeichnen; betrachtet man die Sommerferienzeiträume der Bundesländer im Jahr 2014, so liegt die Vermutung nahe, dass wie schon im Vorjahr die Ferienzeit diese überporportional hohen Umsätze signifkant beeinflusst hat.
  • An den ersten drei Septemberwochenenden sowie an den Oktoberwochenenden sind ebenfalls Ausreißer zu verzeichnen; hinzu kommt im Oktober zudem der Tag der Deutschen Einheit.
  • Im November beschränken sich die Ausreißerumsätze auf die Sonntage; dies gilt mit Ausnahme des So, 21.12. auch für den Dezember; hinzu kommen im Dezember weiterhin der Di, 30. und der Mi, 31.12; auch im Jahr 2014 ist wieder kein “Weihnachts-Effekt” sichtbar.
  • Insgesamt gibt es im Jahr 2014 einen Tag (Mi, 31.12.), an denen zwei Warengruppen Ausreißer sind (jeweils WG 2 + 5). Am 05.05. gibt es sogar Ausreißer in drei Warengruppen (WG 2, 3, 5).
  • Mit mehr als 120 Ausreißern innerhalb eines Jahres ist das Jahr 2014 ein vglw. außergewöhnlich “ausreißerstarkes” Jahr (gewöhnlich liegt die Anzahl pro Jahr zwischen ~ 30 - 50 Ausreißern). Man könnte das Jahr 2014 selbst fast als Ausreißerjahr bezeichnen.

2015

  • Im Zeitraum Januar bis März sind insgesamt nur vier Ausreißer zu beobachten; diese liegen jeweils auf einem Sonntag
  • Das Osterwochenende im April (So, 05.04 + Mo, 06.04.) ist gewohnt stark; im Unterschied zu 2014 ist jedoch an Karfreitag kein Ausreißer-Umsatz zu verzeichnen. Ansonsten ist der April nicht von Ausreißern betroffen.
  • Der Monat Mai + Anfang sind vergleichbar mit dem Vorjahr: überproportional hohe Umsätze am Sonntag nach Himmelfahrt (17.05.) sowie am Pfingstwochende (So, 24. + Mo, 25.05.).
  • Der Juni erscheint schwächer als im Vorjahr; es ist lediglich ein leichter Wochenendeffekt sichtbar (Sa, 13.06., Sa, 20.06; sowie am zweiten “KiWo-Wochenende” 27. + 28.06.), der Effekt der Kieler Woche ist schwächer im Vergleich zum Vorjahr.
  • Auch im Jahr 2015 scheinen die Sommerferien einen Einfluss zu haben, jedoch einen geringeren als im Vorjahr:
    • im Juli sind in den ersten drei Wochen (01.07. - 19.07.) nur Wochenendeffekte zu beobachten
    • die Phase, in der jeder Tag ein Ausreißer ist, erstreckt sich 2015 nur über 3 Wochen (20.07. - 09.08.); in der Woche vom 10.08 - 16.08. sind zwar noch vier Ausreißer zu verzeichnen, ansonsten beschränken sich die Ausreißer im Rest des Augustes auf die Wochenenden.
  • Der nächste und einzige weitere Ausreißer im Jahr 2015 ist an Silvester zu beobachten.

2016

  • Im Jahr 2016 taucht der erste Ausreißer am Sonntag des ersten Februarwochenendes auf (07.02.).
  • Das Osterwochenende Ende März (Sa, 04.04 + Mo, 06.04.) ist abermals stark, an jedem Tag sind Ausreißer zu finden.
  • Im April gibt es im Jahr 2016 keinen einzigen Ausreißer, wobei in diesem Jahr auch kein Feiertag in den April fällt.
  • Wie schon im Vorjahr ist an Christi Himmelfahrt (05.05.) selbst kein Ausreißer zu beobachten, wohl aber an dem darauf folgenden Sonntag (wie 2015). Ein weiterer Ausreißer im Mai liegt auf dem Pfingstmontag (16.05.).
  • Die Kieler Woche-Umsätze sind abermals schwach mit Blick auf Ausreißer; lediglich am 2. KiWo-Wochenende sind Ausreißer zu verzeichnen.
  • Die Sommerferienzeit von Ende Juli bis Mitte August ist wie gewohnt mit vielen Ausreißern versehen, jedoch weniger als in den beiden Vorjahren. Ende August beschränken sich die Ausreißer auf die beiden Wochenendtage.
  • Der Rest des Jahres verläuft ausreißertechnisch typisch. Es gibt zwei vereinzelte Ausreißer an zwei Sonntagen (02.10. und 18.12); Silvester ist erwartbar stark, sowohl in Warengruppe 2 als auch in Warengruppe 5.

2017

  • Was AUsreißer anbelangt, ist das Jahr 2017 ein auffällig schwaches Jahr. Es ist mit knapp 30 Ausreißern im ganzen Jahr das schwächste von allen (Vgl. 2014: > 120).
  • Die ersten beiden Ausreißer sind erst im April am Osterwochenende (15. + 16.04.) zu beobachten; ein weiterer Ausreißer kommt am letzten Aprilsonntag vor, im Mai gibt es nur einen Ausreißer am Sonntag nach Christi Himmelfahrt.
  • Im Juni gibt es einen bemerkenswerten Ausreißer am Mo, 05.06. (Montag generell ungewöhnlich für Ausreißer); weiterhin sind an den beiden KiWo-Wochenenden Ausreißer zu verzeichnen.
  • Ein gewisser Sommerferieneffekt ist sichtbar, dieser ist jedoch deutlich schwächer al sin den Vorjahren.
  • Bemerkenswert ist ein zweiter Ausreißer an Heiligabend. 2017 ist das einzige Jahr, in dem Weihnachten bzw. genauer Heiligabend einen Ausreißer in der Warengruppe 2 zu verzeichnen hat.
  • Zudem ist 2017 das einzige Jahr, in dem an Silvester kein Ausreißer in Warengruppe 2 zu beobachten ist.

Fazit: Insgesamt ein eher untypisches Jahr was Ausreißer anbelangt, sowohl von der Anzahl her als auch teilweise von der Verteilung.

2018

  • Im Jahr 2018 gibt es einen ersten Ausreißer am Ostersonntag Anfang April (01.04.); der Mai profitiert von der Lage von Christi Himmelfahrt und Pfingsten.
  • Im Juni sind an den beiden Wochenenden vor der KiWo einzelne Ausreißer zu verzeichnen; das erste KiWo-Wochenende ist stark. Insbesondere der Sa, 23.06. ist auffällig, das es der einzige Samstag ist, an dem für zwei Warengruppen (2 + 5) Ausreißer zu verzeichnen sind.
  • Der gewohnte Sommerferien-Effekt ist von Mitte Juli bis Mitte August bemerkbar und wieder deutlich stärker als im Vorjahr. Ein letzter Ausreißer im August ist am Sa, 25.08. zu verzeichnen. Danach gibt es im gesamten Jahresverlauf nur noch den gewohnten Silvesterausreißer.

2019

  • Im Jahr 2019 gibt es zwei vereinzelte Sonntags-Ausreißer Ende Februar und Ende März.
  • Ostern, Christi Himmelfahrt und Pfingsten sind gewohnt stark:
    • Ostern: Ausreißer von Sa, 20.04. - Mo, 22.04.
    • Christi Himmelfahrt: Sowohl an Christi Himmelfahrt selbst (30.05.) als auch am darauffolgenden Samstag (01.06.) sind Ausreißer beobachtbar.
    • Am Pfingstwochenende (Sa, 08. - Mo, 10.06.) sind an allen Tagen Ausreißer zu verzeichnen.
  • Wiederum stark im Juni sind die beiden Kieler Woche-Wochenenden (22.-23. sowie 29.-30.06.).
  • Der Sommerferieneffekt beginnt Mitte Juli (Sa, 13.07.) und hält bis zum Ende des Monats an.

Am Ende der Auswertung wird deutlich, dass für einzelne Daten, z. B. den 05.05.2014, auffällig hohe Umsätze in mehreren Warengruppen vorliegen. Eine Überprüfung auf doppelt belegte Daten ergibt:

## # A tibble: 9 x 3
##   Datum      Umsatz Warengruppe
##   <date>      <dbl>       <dbl>
## 1 2014-05-05   749.           5
## 2 2018-06-23   662.           5
## 3 2015-12-31   644.           2
## 4 2014-12-31   643.           2
## 5 2018-12-31   618.           2
## 6 2013-12-31   586.           2
## 7 2013-08-11   583.           5
## 8 2016-12-31   570.           2
## 9 2014-05-05   566.           3
## # A tibble: 339 x 1
##    Datum     
##    <date>    
##  1 2014-12-31
##  2 2015-12-31
##  3 2016-12-31
##  4 2018-12-31
##  5 2013-12-31
##  6 2017-12-31
##  7 2014-05-05
##  8 2013-08-03
##  9 2014-08-09
## 10 2013-07-28
## # ... with 329 more rows

Für acht Daten ergibt sich, dass für diese mehrere Umsätze für einen Tag eingetragen wurden:

  • 2013-08-11: 666.91€ (WG 2), 583.49 € (WG 5)
  • 2013-12-31: 586.13€ (WG 2), 1625.69€ (WG 5)
  • 2014-05-05: 1203.43€ (WG 2), 565.94€ (WG 3), 749.22€ (WG 5)
  • 2014-12-31: 643.37€ (WG 2), 1879.46€ (WG 5)
  • 2015-12-31: 643.67€ (WG 2), 1869.94€ (WG 5)
  • 2016-12-31: 569.61€ (WG 2), 1705.14€ (WG 5)
  • 2018-06-23: 706.42€ (WG 2), 662.37€ (WG 5)
  • 2018-12-31: 618.31€ (WG 2), 1668.12€ (WG 5)

Auch die Über- bzw. Gegenprüfung bestätigt dies: es gibt nur 339 nicht doppelte Fälle gibt.

Zusammenfassung der Erkenntnisse:

  • Warengruppe 2 (Brötchen) ist mit großem Abstand die Warengruppe mit den meisten Ausreißern, diese sind in jedem Jahr überwiegend in der Sommerfereinzeit zu verzeichnen. Weitere Ausreißer gibt es in Warengruppe 5 (Kuchen). Die Ausreißer der WG 5 sind insbesondere an Silvester zu beobachten. Einen einzelnen Ausreißer gibt es in der WG 3 (Croissant) am 05.05.2014.
  • Die Struktur der Verteilung der Ausreißer ist in allen Jahren ähnlich, hat jedoch gewisse Abweichungen in den einzelnen Jahren (vgl. bspw. die Verteilung der Ausreißer in den Jahren 2014 und 2017). Was die Anzahl Ausreißer insgesamt pro Jahr anbelangt, gibt es deutliche Schwankungen. Dies sollte ggf. bei den weitergehenden Analysen noch einmal gesondert berücksichtigt werden.
  • Die Sommerferien (der Tourismus) scheinen einen signifikanten Einfluss auf den Umsatz zu haben; dies gilt nicht für die übrigen Ferien des Jahres. Allerdings scheint es ebenfalls entscheidend zu sein, wie die Sommerferien in den einzelnen Bundesländern liegen (starten die Fereien vglw. früh oder eher spät, gibt es Überschneidungen bei großen BuLä, wie lange dauern diese Überschneidungen an)
  • Das Wochenende ist insgesamt ebenfalls ein bedeutender Einflussfaktor; dieser Effekt beschränkt sich jedoch zeitweise nur auf den Sonntag (je nach Jahreszeit).
  • Die Kieler Woche beeinflusst die Umsätze der betrachteten Filiale in einzelnen Jahren des betrachteten Zeitraums maßgeblich, der Effekt ist jedoch nicht allzu groß.
  • Feiertage haben nur teilweise einen bedeutsamen Einfluss auf den Umsatz (Ostern, Christi Himmelfahrt, Pfingsten, Tag der Deutschen Einheit, Silvester, nicht jedoch Weihnachten); andere Feiertage wie der Reformationstag haben keinen Einfluss.
  • Die stärksten Ausreißer eines jeden der betrachteten Jahre sind jeweils an Silvester zu verzeichnen.

Als nächstes wird der Datensatz Wetter auf Ausreißer hin überprüft:

Nur die Variable Windgeschwindigkeit enthält 7 Ausreißer (Stürme).

2.7 Deskriptive Statistik

Wir werfen einen ersten Blick auf den Gesamtumsatz und den Mittelwert des Umsatzes je Warengruppe.

## Warengruppe
##         1         2         3         4         5         6 
## 272046.42 874857.56 364835.24 184680.16 605741.79  23386.15
## Warengruppe
##         1         2         3         4         5         6 
## 125.13635 402.41838 167.81750  87.11328 278.63008  67.20159

Wir prüfen nun, wie viele Datensätze wir je Warengruppe vorfinden und über welchen Zeitraum sich die Datensätze erstrecken.

## # A tibble: 6 x 2
##   Warengruppe     n
##         <dbl> <int>
## 1           1  2174
## 2           2  2174
## 3           3  2174
## 4           4  2120
## 5           5  2174
## 6           6   348
## # A tibble: 6 x 3
##   Warengruppe min_dat    max_dat   
##         <dbl> <date>     <date>    
## 1           1 2013-07-01 2019-07-30
## 2           2 2013-07-01 2019-07-30
## 3           3 2013-07-01 2019-07-30
## 4           4 2013-07-01 2019-07-30
## 5           5 2013-07-01 2019-07-30
## 6           6 2013-10-24 2018-12-28

Für die Warengruppen 1, 2, 3 und 5 gibt es jeweils 2.174 Datensätze, für die Warengruppe 4 sind es 2.120 Datensätze. Auffällig ist, dass es für die Warengruppe 6 nur 348 Datensätze gibt.

Die Datensätze für die ersten 5 Warengruppen erstrecken sich über denselben Zeitraum: 1.7.2013 bis 30.7.2019. Die erste Vermutung war, dass für die 6. Warengruppe nur ein eingeschränkter Zeitraum zur Verfügung steht. Dieser Verdacht wird widerlegt: Der Zeitraum der Daten für die 6. Warengruppe ist nur geringfügig kürzer und geht vom 24.10.2013 bis 28.12.2018.

Entscheidung: Die Warengruppe 6 wird in der Modellierung nicht betrachtet.

Welches sind die 20 umsatzstärksten Tage des Jahres (Gesamtumsatz pro Tag)?

## Selecting by Gesamtumsatz
## # A tibble: 20 x 2
##    Datum      Gesamtumsatz
##    <date>            <dbl>
##  1 2014-05-05        3156.
##  2 2015-12-31        3015.
##  3 2014-12-31        2939.
##  4 2018-12-31        2805.
##  5 2016-12-31        2773.
##  6 2013-12-31        2615.
##  7 2017-12-31        2378.
##  8 2014-08-18        2121.
##  9 2014-06-28        2096.
## 10 2019-06-29        2035.
## 11 2013-08-03        2022.
## 12 2016-08-13        2014.
## 13 2014-08-24        1989.
## 14 2019-04-20        1988.
## 15 2018-06-23        1987.
## 16 2014-08-23        1975.
## 17 2014-08-09        1958.
## 18 2018-08-18        1950.
## 19 2017-04-15        1950.
## 20 2014-08-16        1934.

Üblicherweise bilden die Silvestertage mit Abstand die Umsatzspitzen. Bereits vorher war uns der 05.05.2014 aufgefallen, den wir später genauer untersuchen werden.

3 Datenaufbereitung, Erstellung von Rohdatensatz und Analysedatensätzen

3.1 Umgang mit Ausreißern

Zwei der 7 verbleibenden Variablen enthalten Ausreißer: Umsatz und Windgeschwindigkeit. Beim Umgang mit den vorhandenen Ausreißern muss differenziert werden, ob es sich um unerwartete / nicht prognostizierbare Ausreißer handelt oder ob diese in gewisser Hinsicht planbar sind, weil sie erwartbar sind, da sie in allen Jahren gleichermaßen zu beobachten sind (z.B. Silvester). Prognostizierbare Ausreißer werden im weiteren Verlauf kodiert, d.h. es werden Variablen für diese planbaren Ausreißer angelegt.

Was die vorliegenden Daten anbelangt, sind einzig die Umsätze am Montag, 05.05.2014 auf den ersten Blick nicht zu erklären. Dieser Tag ist der umsatzstärkste Tag im gesamten Zeitverlauf. Zudem ist es der einzige Tag im gesamten Datensatz, bei dem es Ausreißer für drei Warengruppen gibt (ansonsten beschränken sich die Ausreißer weitestgehend auf Warengruppe 2, vereinzelt gibt es Tage, an denen auch Warengruppe 5 Ausreißer aufweist, z.B. an Silvester).

Bei genauerem Hinsehen haben wir festgestellt, dass für die beiden Vortage 03.05.2014 und 04.05.2014 keine Umsatzdaten vorliegen und zwar für alle Warengruppen. Der Verdacht liegt nahe, dass die Umsätze für den Zeitraum 03.-05.05.2014 summiert für den 05.05.2014 angesetzt wurden. Wir finden nämlich für den 05.05.2014 insgesamt einen Umsatz in Höhe von 3.156. Für den Vergleichszeitraum eine Woche später (10.-12.05.2014) finden wir einen Gesamtumsatz in vergleichbarer Höhe: 3.267. Es handelt sich bei keinem der Tage um einen Feiertag.

Wir korrigieren die Werte für den Zeitraum 03.-05.05.2014 und setzen dafür vereinfachend die Werte der Folgewoche ein. Wir erstellen einen Datensatz df als Kopie der Beispieldaten. Dann löschen wir zunächst den 05.05.2014, laden die korrigierten Werte für den 03.-05.05.2014 aus dem Datensatz Beispieldaten_Korrektur.csv und verknüpfen ihn mit df.

## # A tibble: 1 x 2
##   Datum      Summe_Umsatz
##   <date>            <dbl>
## 1 2014-05-05        3156.
## # A tibble: 3 x 2
##   Datum      Summe_Umsatz
##   <date>            <dbl>
## 1 2014-05-10        1209.
## 2 2014-05-11        1192.
## 3 2014-05-12         867.
## Parsed with column specification:
## cols(
##   Datum = col_date(format = ""),
##   Warengruppe = col_double(),
##   Umsatz = col_double()
## )
## # A tibble: 5 x 4
##   Datum      Warengruppe Umsatz  Jahr
##   <date>           <dbl>  <dbl> <dbl>
## 1 2014-05-05           1  118.   2014
## 2 2014-05-05           2  329.   2014
## 3 2014-05-05           3  124.   2014
## 4 2014-05-05           4   67.5  2014
## 5 2014-05-05           5  229.   2014

Da die anderen Ausreißer durch jeweilige Sondereffekte zu erklären sind (Wochenende, Feiertag, Brückentag etc.) werden diese Ausreißer im Datensatz belassen und im Fortgang hierfür gesonderte Variablen angelegt.

3.2 Umgang mit Warengruppe 6

Die Anzahl der Datensätze je Warengruppe differiert teilweise stark, insbesondere Warengruppe 6 ist auffällig:

  • Warengruppen 1, 2, 3 und 5: jeweils 2.174 Datensätze
  • Warengruppe 4: 2.120 Datensätze
  • Warengruppe 6: 348 Datensätze.

Die Datensätze der Warengruppe 6 werden infolgedessen gelöscht:

Nach dem Löschen der Datensätze enthält der Datensatz nunmehr 10826 Zeilen.

3.3 Rohdaten mit vollständiger Zeitreihe

Zunächst wird ein weiterer Datensatz df_voll erstellt, der eine komplette Zeitreihe enthält vom 1.7.2013 bis 31.7.2019 für alle Warengruppen 1 bis 5. Dabei wird in Kauf genommen, dass dieser zunächst viele fehlende Werte enthalten wird, die im weiteren Verlauf für die einzelnen Modelle sinnvoll zu ergänzen sind:

3.4 Vereinigung der Datensätze

Bei der Untersuchung der Datumsvariablen der einzelnen Datensätze ergab sich, dass diese über unterschiedliche Zeiträume reichen:

  • Die Daten des Datensatzes Beispieldaten reichen vom 01.07.2013 bis zum 30.07.2019, sind aber teilweise unvollständig. Es fehlen bspw. für alle Warengruppen Daten für den Tag der Arbeit, Weihnachten, Neuhjahr etc. Weiterhin fehlen insbesondere bei der Warengruppe 4 immer wieder einzelne Daten in den Sommermonaten, vereinzelt auch an einzelnen Tagen im Herbst.
  • Die Daten des Datensatzes KiWo reichen vom 16.06.2012 bis zum 30.06.2019.
  • Die Daten des Datensatzes Wetter reichen vom 01.01.2012 bis zum 01.08.2019.

Maßgeblich ist für uns der Zeitraum der vollstängien Zeitreihe df_voll vom 01.07.2013 bis zum 31.07.2019. Wir fügen über ein left_join die Daten zur Kieler Woche und die Wetterdaten an.

## # A tibble: 6 x 9
##   Datum      Warengruppe Umsatz  Jahr KielerWoche Bewoelkung Temperatur
##   <date>           <dbl>  <dbl> <dbl>       <dbl>      <dbl>      <dbl>
## 1 2013-07-01           1  149.   2013          NA          6       17.8
## 2 2013-07-01           2  536.   2013          NA          6       17.8
## 3 2013-07-01           3  201.   2013          NA          6       17.8
## 4 2013-07-01           4   65.9  2013          NA          6       17.8
## 5 2013-07-01           5  317.   2013          NA          6       17.8
## 6 2013-07-02           1  160.   2013          NA          3       17.3
## # ... with 2 more variables: Windgeschwindigkeit <dbl>, Wettercode <dbl>

3.5 Korrektur der Anzahl Nachkommastellen für einzelne Variablen

Die Variablen Umsatz und Temperatur enthalten jeweils vier Nachkommastellen, die als überflüssig und unsinnig erachtet werden. Die Anzahl der Nachkommstellen wird entsprechend korrigiert, wobei die Anzahl Nachkommastellen bei der Variable Umsatz auf 2 Nachkommastellen, die Variable Temperatur auf 1 Nachkommastelle gerundet wird:

## # A tibble: 6 x 9
##   Datum      Warengruppe Umsatz  Jahr KielerWoche Bewoelkung Temperatur
##   <date>           <dbl>  <dbl> <dbl>       <dbl>      <dbl>      <dbl>
## 1 2013-07-01           1  149.   2013          NA          6       17.8
## 2 2013-07-01           2  536.   2013          NA          6       17.8
## 3 2013-07-01           3  201.   2013          NA          6       17.8
## 4 2013-07-01           4   65.9  2013          NA          6       17.8
## 5 2013-07-01           5  317.   2013          NA          6       17.8
## 6 2013-07-02           1  160.   2013          NA          3       17.3
## # ... with 2 more variables: Windgeschwindigkeit <dbl>, Wettercode <dbl>

3.6 Umgang mit fehlenden Werten

Der Datensatz KiWo enthält nur 72 Datensätze: für jedes Jahr wurde den Tagen, an denen die KiWo stattfindet, eine 1 zugeordnet. Diese Werte wurden Bei der Vereinigung der Datensätze entsprechend korrekt gemerged. Für alle anderen Daten, an denen keine KiWo ist, wurde bei der Vereinigung ein fehlender Wert (NA) automatisch erzeugt. Diese fehlenden Werte sind für die weitergehenden Analysen durch “0” zu ersetzen:

## # A tibble: 6 x 9
##   Datum      Warengruppe Umsatz  Jahr KielerWoche Bewoelkung Temperatur
##   <date>           <dbl>  <dbl> <dbl>       <dbl>      <dbl>      <dbl>
## 1 2013-07-01           1  149.   2013           0          6       17.8
## 2 2013-07-01           2  536.   2013           0          6       17.8
## 3 2013-07-01           3  201.   2013           0          6       17.8
## 4 2013-07-01           4   65.9  2013           0          6       17.8
## 5 2013-07-01           5  317.   2013           0          6       17.8
## 6 2013-07-02           1  160.   2013           0          3       17.3
## # ... with 2 more variables: Windgeschwindigkeit <dbl>, Wettercode <dbl>

Da die Variable Wettercode vglw. viele fehlende Werte hat (669) und unklar ist, wie diese fehlenden Werte sinnvoll ersetzt werden können, wird diese Variable ignoriert und eliminiert:

## # A tibble: 6 x 8
##   Datum      Warengruppe Umsatz  Jahr KielerWoche Bewoelkung Temperatur
##   <date>           <dbl>  <dbl> <dbl>       <dbl>      <dbl>      <dbl>
## 1 2013-07-01           1  149.   2013           0          6       17.8
## 2 2013-07-01           2  536.   2013           0          6       17.8
## 3 2013-07-01           3  201.   2013           0          6       17.8
## 4 2013-07-01           4   65.9  2013           0          6       17.8
## 5 2013-07-01           5  317.   2013           0          6       17.8
## 6 2013-07-02           1  160.   2013           0          3       17.3
## # ... with 1 more variable: Windgeschwindigkeit <dbl>

3.7 Ergänzung um die Variablen Wochentag, Monat und Jahr

Ein wesentlicher Einflussfaktor für die Umsatzprognose wird der Wochentag sein, wir fügen diesen als eigene Spalte hinzu: Sonntag (1), Montag (2), … , Samstag (7). Und für die spätere Aufteilung der Daten in Training- und Testset wird das Jahr als weitere Spalte ergänzt und der Monat.

Damit die Wochentage adäquat in die späteren Modelle einfließen können, wird der Wochentag überdies als character-Variable abgespeichert.

Bsp.: Soll der Wochentag ein lineare Regressionsmodell aufgenommen werden, würde eine numerische Variable zu falschen Ergebnissen führen (wird der Wochentag um eins erhöht, erhöht sich der Umsatz um xy%). Bei einer character-Variable würde diese “dummyfiziert”. Ein Wochentag würde als Referenztag abgebildet werden und die anderen 6 Wochentage in Form von Dummyvariablen.

Es besteht die Möglichkeit, dass es unterhalb der Wochentag keine großen Unterschiede gibt, wohl aber zwischen Wochentagen und Wochenendtagen. Insofern wird eine weitere Variable Wochenende erstellt, die nur die beiden Ausprägungen 1 = “Wochenende” und 0 = “kein Wochenende” (“Wochentag”) hat.

3.8 Ergänzung um Sommerferienvariablen

Die Sommerferien scheinen einen starken Einfluss auf den Umsatz zu haben. Für die anderen Ferienzeiträume des Jahres gilt dies nicht. Für ausgewählte Bundesländer, namentlich Schleswig-Holstein, Nordrhein-Westfalen, Niedersachsen und Hessen wurden daher zunächst Datensätze in Excel erstellt (1 Datensatz je Bundesland). Diese Datensätze enthalten die Zeiträume der Sommerferien über die einzelnen Jahre. Diese Datensätze werden in R eingelesen und mit den anderen Daten zusammengeführt.

Die Auswahl der genannten Bundesländer erfolgte dabei anhand der Besucherzahlen / Übernachtungsvolumina in den vergangenen Jahren. Die meisten Gäste in Schleswig-Holstein kommen aus NRW, gefolgt von Niedersachsen und Schleswig-Holstein. Die Besucherzahlen aus Hessen lagen in den vergangenen Jahren etwas unterhalb derer von Niedersachsen und Schleswig-Holstein. Für Bayern und Baden-Württemberg werden zwar für die nähere Zukunft große Wachstumspotentiale prognostiziert, die Volumina waren in den betrachteten Zeiträumen jedoch gering und können daher vernachlässigt werden. Ebenso vernachlässigbar sind die übrigen Bundesländer.

3.9 Ergänzung um Feiertagsvariablen

Die ersten Betrachtungen und Analysen lassen den Schluss zu, dass bestimmte Feiertage Einfluss auf die Höhe des Umsatzes haben.

Es existieren unterschiedliche Möglichkeiten, die Variable Feiertag für die Modellierung abzubilden / zu erfassen:

  1. Anlegen einer generellen Feiertagsvariable: Feiertag ja/nein bzw. 1/0
  2. Anlegen einer Variable für die einzelnen relevanten Feiertage.

Zu 1.: Begonnen wird mit der generellen Feiertagsvariable. Ausgewählte Feiertage (Karfreitag, Ostern, Christi Himmelfahrt, Pfingsten, Tag der Deutschen Einheit) werden daher zunächst in einer Excel-Datei gespeichert. Nach dem Einlesen der Datei werden die Daten zum Analysedatensatz hinzugefügt.

Zu 2.: Hier gibt es wiederum unterschiedliche Möglichkeiten. Zum einen kann man sich bei der Erstellung spezifischer Feiertagsvariablen, wie z. B. Ostern, rein auf die eigentlichen Feiertage beschränken, zum anderen könnten auch die Tage davor oder danach (Stichwort Brückentage, verlängertes Wochenende) in eine solche Feiertagsvariable einbezogen werden. Für die Feiertage Karfreitag/Ostern (ohne Karfreitag, da die Filiale an diesem Tag geschlossen ist und dementsprechend keine Daten verfügbar sind), Christi Himmelfahrt, Pfingsten, Tag der Deutschen Einheit und Silvester werden beide Varianten umgesetzt.

Zunächst werden Variablen erstellt, die nur die Feiertage enthalten:

In einem nächsten Schritt werden Variablen erstellt, die neben den Feiertagen auch “Brückentage” / den vorherigen oder darauffolgenden Tag enthalten. Bezüglich der Frage, welche umgebenden Tage im Speziellen berücksichtigt werden, wird auf die Umsätze der umgebenden Tage in der Vergangenheit referenziert. Sind diese signifikant / bedeutend höher als vergleichbare Wochentage, so werden diese mit einbezogen. Ausgenommen wird an dieser Stelle der Tag der Deutschen Einheit, da der Einfluss umgebender Tage bei diesem einzelnen Feiertag sehr davon abhängt, auf welchen Wochentag der Feiertag fällt.

3.10 Ergänzung um Variable Jahreszeit

Die ersten Betrachtungen und Analysen lassen darauf schließen, dass die Jahreszeiten einen Einfluss auf die Höhe des Umsatzes haben.

Die Variable Jahreszeiten kann bzw. muss dabei differenziert betrachtet werden. Zum einen besteht die Möglichkeit, Jahreszeiten als vorgegebene bzw. eigens definierte Variablen abzubilden. Dabei kann man bspw. den astronomische Eigenschaften zugrunde legen. Andererseits gibt es Modelle, die von sich heraus aus fiktive bzw. synthetische Jahreszeiten im Hintergrund ableiten.

Bsp.: Jahreszeiten können im Rahmen eines Entscheidungsbaums derart generiert werden, dass März, April, Mai zusammengefasst werden und zusätzlich aufgrund struktureller Ähnlichkeiten der September und der Oktober zu dieser (synthetischen) Jahreszeit hinzugefügt werden.

Die erste Möglichkeit soll an dieser Stelle umgesetzt werden. Die zweite Möglichkeit wird im weiteren Verlauf bei der Anwendung der unterschiedlichen Modelle relevant sein.

Anlegen einer eigens definierten Jahreszeit-Variable

Grundsätzlich unterteilen die Jahreszeiten das Jahr in verschiedene Perioden, welche sich durch charakteristische astronomische oder klimatische Eigenschaften auszeichnen. Im alltäglichen Sprachgebrauch sind damit hauptsächlich meteorologisch deutlich voneinander unterscheidbare Jahresabschnitte gemeint; in gemäßigten Breiten sind dies Frühling, Sommer, Herbst und Winter. (http://www.hrhen.de/wk/html/jahreszeiten.html, https://vschweiz.ch/jahreszeitenbeginn/)

Legt man astronomische Jahreszeitenanfänge für die Erstellung einer ersten Jahreszeit-Variable zugrunde, sind folgende Daten zu berücksichtigen:

Jahr Frühling Sommer Herbst Winter
2013 20. März 21. Juni 22. September 21. Dezember
2014 20. März 21. Juni 23. September 22. Dezember
2015 20. März 21. Juni 23. September 22. Dezember
2016 20. März 21. Juni 22. September 21. Dezember
2017 20. März 21. Juni 22. September 21. Dezember
2018 20. März 21. Juni 23. September 21. Dezember
2019 20. März 21. Juni 23. September 22. Dezember

Es gibt wiederum zwei Möglichkeiten, die Variable anzulegen:

  1. Anlegen einer Variable mit allen Jahreszeiten
  2. Je eine Variable pro Jahreszeit

Zunächst wird eine Variable für alle Jahreszeiten erstellt bzw. eingelesen und an den bestehenden Rohdatensatz hinzugefügt:

In einem weiteren Schritt werden für die einzelnen Jahreszeiten eigene Variablen angelegt und mit dem bestehenden Rohdatensatz verknüpft:

3.11 vollständige Datenreihe, Imputationen, Trainingsdaten, Testdaten

vollständige Datenreihe

Ergebnis der vorangegegangenen Operationen ist der Datensatz df_voll, der eine vollständige Zeitreihe vom 01.07.2013 bis 31.07.2019 für die Warengruppen 1 bis 5 enthält, angereichert um zahlreiche Variablen wir Kieler Woche, Wetterdaten, Sommerferien, Feiertage.

In diesem Datensatz fehlen teilweise die Umsätze für einzelne Tage und/oder Warengruppen, weil die Rohdaten fehlende Werte aufweisen.

Der Datensatz df_voll kann für einzelne Analysen ohne Weiteres verwendet werden, z.B. für eine Regressionsanalyse. Möchte man Vorhersagen auf Basis der Vorwochenwerte durchführen, z.B. die Umsatz-Prognose für den aktuellen Montag auf Basis des vorangegangenen Montags durchführen, könnten Probleme auftreten, da der Vorwochenwert aufgrund der unterbrochenenen Zeitreihe ggf. nicht verfügbar ist.

Imputation: Ergänzung fehlender Werte

Fehlende Daten sind im Datensatz df_voll mit NA gefüllt. Das bereitet für die Anwendung u.a. der naiven Modelle Probleme: Wenn bspw. der Umsatz auf Basis des Vorwochenwertes geschätzt werden soll, dann wird ein “sinnvoller” Umsatz für jedes Datum erwartet.

Zuerst kennzeichnen wir im Datensatz df_voll die Zeilen, die fehlende Umsatzwerte aufweisen mit einem neuen Attribut “Umsatz_NA”, das die Werte TRUE (Umsatz fehlt in den Rohdaten und wurde ergänzt) und FALSE (Umsatz vorhanden in den Rohdaten) annimmt.

Danach wollen wir diese fehlenden Umsätze durch Werte aus der Vergangenheit ersetzen. In der Regel gucken wir uns die Umsätze der Vorwoche an dem entsprechenden Wochentag an. Eine Ausnahme machen wir für die fehlenden Umsätze an Silvester und Neujahr: Da die Vorwochenwerte erhöht sind (Heiligabend) bzw. fehlen, gehen wir 4 Wochen zurück, weil die ersetzten Werte dann als Schätzer bspw. für die Folgewoche verwendet werden sollen.

Fehlende Umsätze (Umsatz_NA = TRUE) werden dann ersetzt durch den Vorwochenwert (Umsatz_lag_1W). Falls der Wert ebenfalls fehlt, gehen wir 2 Wochen zurück (Umsatz_lag_2W). Und falls der Wert ebenfalls fehlt, gehen wir 3 Wochen zurück (Umsatz_lag_3W). Eine Ausnahme bilden Silvester und Neujahr (Silvester_ext=1): In diesem Fall wollen wir den fehlenden Umsatz aus dem Wert vor 4 Wochen nehmen (Umsatz_lag_4W).

Der ersetzte Wert wird in einer separaten Variable “Umsatz_lag” gespeichert:

## # A tibble: 3 x 39
##   Datum      Warengruppe Umsatz  Jahr KielerWoche Bewoelkung Temperatur
##   <date>           <dbl>  <dbl> <dbl>       <dbl>      <dbl>      <dbl>
## 1 2013-08-05           4     NA  2013           0          0       25.8
## 2 2014-12-25           4     NA  2014           0          7        3.1
## 3 2014-12-26           4     NA  2014           0          6        0  
## # ... with 32 more variables: Windgeschwindigkeit <dbl>, Wochentag <dbl>,
## #   Monat <dbl>, Wochentag_c <chr>, Monat_c <chr>, Wochenende <dbl>,
## #   SommerferienSH <dbl>, SommerferienNRW <dbl>, SommerferienNDS <dbl>,
## #   SommerferienHE <dbl>, Feiertag <dbl>, Ostern <dbl>,
## #   ChristiHimmelfahrt <dbl>, Pfingsten <dbl>, TDE <dbl>, Silvester <dbl>,
## #   Ostern_ext <dbl>, ChristiHimmelfahrt_ext <dbl>, Pfingsten_ext <dbl>,
## #   Silvester_ext <dbl>, Jahreszeit <chr>, Fruehling <dbl>, Sommer <dbl>,
## #   Herbst <dbl>, Winter <dbl>, Umsatz_NA <lgl>, Umsatz_lag_1W <dbl>,
## #   Umsatz_lag_2W <dbl>, Umsatz_lag_3W <dbl>, Umsatz_lag_4W <dbl>,
## #   Umsatz_lag <dbl>, Umsatz_lag_temp <dbl>
## # A tibble: 0 x 39
## # ... with 39 variables: Datum <date>, Warengruppe <dbl>, Umsatz <dbl>,
## #   Jahr <dbl>, KielerWoche <dbl>, Bewoelkung <dbl>, Temperatur <dbl>,
## #   Windgeschwindigkeit <dbl>, Wochentag <dbl>, Monat <dbl>,
## #   Wochentag_c <chr>, Monat_c <chr>, Wochenende <dbl>,
## #   SommerferienSH <dbl>, SommerferienNRW <dbl>, SommerferienNDS <dbl>,
## #   SommerferienHE <dbl>, Feiertag <dbl>, Ostern <dbl>,
## #   ChristiHimmelfahrt <dbl>, Pfingsten <dbl>, TDE <dbl>, Silvester <dbl>,
## #   Ostern_ext <dbl>, ChristiHimmelfahrt_ext <dbl>, Pfingsten_ext <dbl>,
## #   Silvester_ext <dbl>, Jahreszeit <chr>, Fruehling <dbl>, Sommer <dbl>,
## #   Herbst <dbl>, Winter <dbl>, Umsatz_NA <lgl>, Umsatz_lag_1W <dbl>,
## #   Umsatz_lag_2W <dbl>, Umsatz_lag_3W <dbl>, Umsatz_lag_4W <dbl>,
## #   Umsatz_lag <dbl>, Umsatz_lag_temp <dbl>

Führe nun den Umsatz aus den Rohdaten (Umsatz) zusammen mit den aus den Vorwochen ermittelten fehlenden Werten (Umsatz_lag).

Trainings- und Testdaten

Wir verwenden den Zeitraum 2014 bis 2017 als Trainingsdaten. Die Daten des Jahres 2018 dienen als Testdaten. Dafür werden weitere Datensätze erstellt. Die Datensätze df_train und df_test basieren auf dem vollstängigen Datensatz df_voll. Der vollständige Datensatz enthält die komplette Zeitreihe vom 01.07.2013 bis 31.07.2019, jedes Datum und jede Warengruppe ist enthalten. Eventuell fehlende Umsätze sind aus den Vorwochen ergänzt. Zeilen, bei denen der Umsatz ergänzt wurden, sind erkennbar am Attribut “Umsatz_NA”, die TRUE ist, wenn in den Rohdaten der Umsatz fehlte.

4 Deskriptive Analysen

4.1 Umsatz je Wochentag / Warengruppe

Untersuche den Umsatz je Wochentag und/oder Warengruppe in den Daten. Als Basis verwenden wir die zunächst den vollständigen Datensatz df_voll.

## # A tibble: 5 x 2
##   Warengruppe Umsatz_sum
##         <dbl>      <dbl>
## 1           1    277596.
## 2           2    890675.
## 3           3    370967.
## 4           4    192355.
## 5           5    617014.
## # A tibble: 7 x 2
##   Wochentag_c Umsatz_sum
##   <chr>            <dbl>
## 1 Dienstag       304703.
## 2 Donnerstag     315295.
## 3 Freitag        318081.
## 4 Mittwoch       303614 
## 5 Montag         313530.
## 6 Samstag        390812.
## 7 Sonntag        402571.
## # A tibble: 35 x 3
## # Groups:   Warengruppe [5]
##    Warengruppe Wochentag_c Umsatz_sum
##          <dbl> <chr>            <dbl>
##  1           1 Dienstag        38815.
##  2           1 Donnerstag      44083.
##  3           1 Freitag         41408.
##  4           1 Mittwoch        37845 
##  5           1 Montag          43193.
##  6           1 Samstag         47593.
##  7           1 Sonntag         24659.
##  8           2 Dienstag       112113.
##  9           2 Donnerstag     115419.
## 10           2 Freitag        117023.
## # ... with 25 more rows
## # A tibble: 35 x 3
## # Groups:   Warengruppe [5]
##    Warengruppe Wochentag Umsatz_sum
##          <dbl>     <dbl>      <dbl>
##  1           1         1     24659.
##  2           1         2     43193.
##  3           1         3     38815.
##  4           1         4     37845 
##  5           1         5     44083.
##  6           1         6     41408.
##  7           1         7     47593.
##  8           2         1    168796.
##  9           2         2    114975.
## 10           2         3    112113.
## # ... with 25 more rows
## # A tibble: 10 x 3
## # Groups:   Warengruppe [5]
##    Warengruppe Wochenende Umsatz_sum
##          <dbl>      <dbl>      <dbl>
##  1           1          0    205343.
##  2           1          1     72252.
##  3           2          0    570332.
##  4           2          1    320343.
##  5           3          0    236159.
##  6           3          1    134809.
##  7           4          0    123959.
##  8           4          1     68396.
##  9           5          0    419431.
## 10           5          1    197583.
  • Warengruppe 2 zeigt den höchsten Umsatz insgesamt, gefolgt von Warengruppe 5.
  • Die Wochentage Samstag und Sonntag sind mit leichtem Abstand die umsatzstärksten Tage, aggregiert über alle Warengruppen.
  • Für die einzelnen Warengruppen zeigt sich ein differenzierteres Bild: Für Brot (Warengruppe 1) sind bspw. Donnerstag und Samstag die umsatzstärksten Wochentage. Auch der Montag ist in dieser Woche überdurchschnittlich stark im Vergleich zu den anderen Warengruppen.
  • Vergleicht man die Wochenendumsätze mit den Umsätzen der Wochentag, so ergibt sich folgendes Bild:
    • 26% der Umsätze der Warengruppe 1 (Brot) werden am Wochenende erzielt, 74% an den Wochentagen
    • 36% der Umsätze der Warengruppe 2 (Brötchen) werden am Wochenende erzielt, 64% unter der Woche.
    • 37% der Umsätze der Warengruppe 3 (Croissants) werden am Wochenende erzielt, 63% an den Wochentagen.
    • 36% der Umsätze der Warengruppe 4 (Konditorei) werden am Wochenende erzielt, 64% unter der Woche.
    • 32% der Umsätze der Warengruppe 5 (Kuchen) werden am Wochenende erzielt, 68% unter der Woche. ==> demnach scheint es für die einzelnen Warengruppen abweichende Wochenend-Effekte geben. Kuchen und Brot werden im Verhältnis zu den anderen Warengruppen am Wochenende weniger verkauft.

4.2 Umsatz je Monat / Warengruppe

In einem weiteren Schritt werden die Umsätze je Warengruppe und Monat untersucht, um eine differenziertere Verteilung der Umsätze im Jahresverlauf zu erhalten.

## # A tibble: 60 x 3
## # Groups:   Warengruppe [5]
##    Warengruppe Monat Umsatz_sum
##          <dbl> <dbl>      <dbl>
##  1           1     1     20130.
##  2           1     2     18439.
##  3           1     3     22556.
##  4           1     4     23667.
##  5           1     5     22545 
##  6           1     6     24037.
##  7           1     7     31048.
##  8           1     8     27465.
##  9           1     9     22756.
## 10           1    10     22876.
## # ... with 50 more rows
## # A tibble: 60 x 3
## # Groups:   Warengruppe [5]
##    Warengruppe Monat_c   Umsatz_sum
##          <dbl> <chr>          <dbl>
##  1           1 Juli          31048.
##  2           1 August        27465.
##  3           1 Juni          24037.
##  4           1 April         23667.
##  5           1 Oktober       22876.
##  6           1 September     22756.
##  7           1 März          22556.
##  8           1 Mai           22545 
##  9           1 Dezember      21791.
## 10           1 November      20284.
## # ... with 50 more rows
  • Es gibt erkennbare Unterschiede zwischen den Warengruppen, was den Umsatz pro Monat anbelangt:
    • In den Warengruppen 1 - 3 (und mit Einschränkung Warengruppe 5) sind die Monate Juli, August und Juni die Top 3-Monate sind,
    • Bei Warengruppe 4 liegen diese Monate auf den Plätzen 3 (August), 6 (Juli) und 11 (Juni). In dieser Waregngruppe ist der Februar der umsatzstärkste Monat, gefolgt von Oktober, der bei den anderen WG eher im Mittelfeld liegt (Platz 4 - 6). Die Warengruppe 4 verhält sich bei der Verteilung der Umsätze im Monatsverlauf also deutlich anders als die anderen Warengruppen.
  • Tendenziell sind die Umsätze in den Wintermonaten (Dezember, Januar, Februar) sowie im November am schwächsten (auch hier mit leichten Abweichungen bei Warengruppe 4 und 5). Die Warengruppen Konditorei und Kuchen unterscheiden sich hier, mal mehr mal weniger, von den ersten drei Warengruppen.

4.3 Umsatz im Zeitverlauf

Von Interesse ist nun die Entwicklung der Umsätze im Zeitverlauf. Wir wollen prüfen, ob eine Trendentwicklung zu beobachten ist und ob es strukturelle Brüche in den Zeitreihen gibt. Wir betrachten dafür zunächst die Entwicklung des Gesamtumsatzes pro Jahr. Als Datenbasis verwenden wir die Trainingsdaten df_train, die den Zeitraum 2014 bis 2017 umfassen und damit 4 Jahresscheiben abbilden.

## # A tibble: 4 x 2
##    Jahr  Umsatz
##   <dbl>   <dbl>
## 1  2014 428295.
## 2  2015 378659 
## 3  2016 359157.
## 4  2017 356290.

Zu beobachten ist, dass der Jahresumsatz von 2014 bis 2016 sukzessive sinkt und dann 2017 stabil bleibt. Um diese Beobachtung besser zu verstehen, betrachten wir den Umsatz nun auf Monatsebene, immer noch aggregiert über alle Warengruppen.

Beobachtungen:

  • Die Jahre 2016 und 2017 sind weitestgehend ähnlich im Jahresverlauf.
  • Die Umsätze im Jahr 2014 sind insgesamt offenbar parallel verschoben und systematisch höher jeden Monat.
  • Und der Verlauf für 2015 ist ähnlich zu 2016 und 2017, nur in den ersten 3 Monaten des Jahres scheint der Umsatz 2015 systematisch höher zu liegen.

Um dies weiter zu analysieren, betrachten wir schließlich noch den Umsatz auf Monatsebene je Warengruppe, um eventuelle Unterschiede im Verhalten der einzelnen Warengruppen aufzudecken.

Erstellung der Variablen Umsatz auf Monatsebene Warengruppe 1

Erstellung des Plots zur Variablen Umsatz auf Monatsebene Warengruppe 2

Erstellung des Plots zur Variablen Umsatz auf Monatsebene Warengruppe 3

Erstellung des Plots zur Variablen Umsatz auf Monatsebene Warengruppe 4

Erstellung des Plots zur Variablen Umsatz auf Monatsebene Warengruppe 5

Beobachtungen:

  • Für die Warengruppen 1, 2, 3 und 5 zeigen sich ähnliche Effekte: Die Umsätze 2014 liegen systematisch höher. Das setzt sich bis in die ersten 3 Monate des Jahres 2015 fort. Ab April 2015 sind die Verläufe ähnlich bis Ende 2017.
  • Die Warengruppe 4 ist insgesamt die umsatzschwächste Gruppe. Die Monatsumsätze sind über die Jahre 2014 bis 2017 relativ ähnlich. Eine Ausnahme bildet der Februar 2017: Hier liegen die Umsätze deutlich unter den Umsätzen der übrigen Jahre. Dafür gibt es bislang keine Erklärung.

Für die weitere Entwicklung unserer Prognosemodelle könnte es daher sinnvoll sein, dass wir uns bei den Trainingsdaten auf den Zeitraum ab April 2015 bis 2017 beschränken und die Zeit davor außer Acht lassen. Und wir behalten im Hinterkopf, dass der Februar 2017 auffällig niedrige Umsätze aufweist.

5 Anwendung naiver Modelle

5.1 Vorhaben

Wir wollen nun einige naive Modelle einsetzen, um die Umsätze je Warengruppe zu prognostizieren. Wir arbeiten dafür mit dem vollständigen Datensatz df_voll, der für jeden Tag und jede Warengruppe eine Zeile enthält. Fehlende Umsatzwerte in den Rohdaten sind durch die Vorwochenwerte ersetzt, weitere fehlenden Daten sind mit NA gefüllt.

Wir werden im folgenden verschiedene naive Prognosemodelle testen und vergleichen. Zuerst betrachten wir die Schätzung des Umsatzes auf Basis des Vorwochenwertes (Umsatz_lag_1W).

Im zweiten Teil betrachten wir die Schätzung mittels eines gleitenden Durchschnitts über die letzten 3 Tage (Umsatz_glDS_3T). Wir wissen bereits, dass der Umsatz am Wochenende systematisch höher ist, als unter der Woche. Daher erwarten wir, dass der gleitende Durchschnitt in der Form nur eingeschränkt geeignet ist, wahrscheinlich nur Für Donnerstag und Freitag. Als Erweiterung könnte man den Umsatz für Wochentage auf Basis des Durchschnitts der letzten drei Wochentage schätzen und den Umsatz für Wochenendtage auf Basis der letzten drei Wochenendtage (Umsatz_glDS_3T_erw), oder sogar auf Basis der letzten vier Wochentage bzw. Wochenendtage (Umsatz_glDS_4T_erw).

Und schließlich betrachten wir einen gewichteten Mittelwert der Vorwochen (Umsatz_gewMW_4W) als Schätzer. Hierbei gewichten wir den Wert der Vorwoche mit 50%, den Wert zwei Wochen zurück mit 25% und den Wert drei Wochen zurück mit 15% und den Wert vier Wochen zurück mit 10%.

Dann werfen wir einen Blick auf die Prognose-Güte:

  • Anteil an zu hoch / zu niedrig geschätzten Umsätze, ggf. je Warengruppe und/oder Wochentag
  • mittlere Abweichung, mittlere absolute Abweichung, mittlere quadratische Abweichung
  • Standardabweichung, Verteilung der Abweichungen

Wir wollen die naiven Modelle in ihrer Prognose-Güte vergleichen. Weiterhin prüfen wir die Top10 stärksten Abweichungen nach oben und nach unten für die verschiedenen Modelle, um rauszufinden, ob es Tage gibt, für die mehrere oder sogar alle naiven Modelle versagen.

5.2 Datenaufbereitung

Wir arbeiten mit dem vollständigen Datensatz df_voll. Dieser enthält im Zeitraum 01.07.2013 bis 31.07.2019 eine Zeile für jedes Datum und jede Warengruppe. In den Rohdaten fehlende Umsätze sind auf Basis der Vorwochenwerte ergänzt worden. Die Zeilen mit ergänzten Umsätzen sind selektierbar über die Variable Umsatz_NA (= TRUE).

Zunächst benötigen wir Werte für folgende Attribute, die teilweise schon vorhanden sind und teilweise neu erstellt werden:

  • Umsatz_lag_1W
  • Umsatz_lag_2W
  • Umsatz_lag_3W
  • Umsatz_lag_4W
  • Umsatz_gewMW_4W
  • Umsatz_lag_1T bis Umsatz_lag_8T, Umsatz_lag_13T, Umsatz_lag_14T (1 bis 8, 13 und 14 Tage zurück)
  • Umsatz_glDS_3T
  • Umsatz_glDS_3T_erw
  • Umsatz_glDS_4T_erw

Wir erstellen für diesen Abschnitt einen Analysedatensatz df_naiv auf Basis von df_voll.

# initialisiere Datensatz
df_naiv <- df_voll

# fülle Umsatz_lag_1W mit dem Vorwochenwert (also 7 Tage mal 5 Warengruppen zurück)
df_naiv <- df_naiv %>% mutate(Umsatz_lag_1W = lag(Umsatz, n=35))

# fülle entsprechend Umsatz_lag_2W, Umsatz_lag_3W, Umsatz_lag_4W
df_naiv <- df_naiv %>% mutate(Umsatz_lag_2W = lag(Umsatz, n=70))
df_naiv <- df_naiv %>% mutate(Umsatz_lag_3W = lag(Umsatz, n=105))
df_naiv <- df_naiv %>% mutate(Umsatz_lag_4W = lag(Umsatz, n=140))

# damit können wir bereits den gewichteten Mittelwert der letzten 4 Wochen erstellen
df_naiv <- df_naiv %>% mutate(Umsatz_gewMW_4W = 0.5*Umsatz_lag_1W + 0.25*Umsatz_lag_2W + 0.15*Umsatz_lag_3W + 0.1 * Umsatz_lag_4W)

# Bereite die Berechnung des gleitenden Durchschnitts der letzten 3 Tage vor.
# Für die Berechnung des erweiterten gleitenden Durchschnitts benötigen wir weitere Tage.
df_naiv <- df_naiv %>% mutate(Umsatz_lag_1T = lag(Umsatz, n=5)) # 1 Tag zurück
df_naiv <- df_naiv %>% mutate(Umsatz_lag_2T = lag(Umsatz, n=10)) # 2 Tage zurück
df_naiv <- df_naiv %>% mutate(Umsatz_lag_3T = lag(Umsatz, n=15)) # 3 Tage zurück
df_naiv <- df_naiv %>% mutate(Umsatz_lag_4T = lag(Umsatz, n=20)) # 4 Tage zurück
df_naiv <- df_naiv %>% mutate(Umsatz_lag_5T = lag(Umsatz, n=25)) # 5 Tage zurück
df_naiv <- df_naiv %>% mutate(Umsatz_lag_6T = lag(Umsatz, n=30)) # 6 Tage zurück
df_naiv <- df_naiv %>% mutate(Umsatz_lag_7T = lag(Umsatz, n=35)) # 7 Tage zurück
df_naiv <- df_naiv %>% mutate(Umsatz_lag_8T = lag(Umsatz, n=40)) # 8 Tage zurück
df_naiv <- df_naiv %>% mutate(Umsatz_lag_13T = lag(Umsatz, n=65)) # 13 Tage zurück
df_naiv <- df_naiv %>% mutate(Umsatz_lag_14T = lag(Umsatz, n=70)) # 14 Tage zurück

# nun können wir den gleitenden Durchschnitt der letzten 3 Tage erstellen
df_naiv <- df_naiv %>% mutate(Umsatz_glDS_3T = (Umsatz_lag_1T + Umsatz_lag_2T + Umsatz_lag_3T) / 3)

# Dir Berechnung des erweiterten gleitenden Durchschnitt ist etwas aufwändiger: Hierfür wollen wir zuerst den Durchschnitt der letzten 3 Wochentage bzw. Wochenendtage ermitteln. Für einen Montag müssen wir also 3, 4 und 5 Tage zurück gehen, für einen Samstag 6, 7 und 13 Tage. Oder anders ausgedrückt: Der Umsatz 1 Tag zurück (Umsatz_lag_1T) fließt in die Berechnung des erweiterten Durchschnitts für die Tage Di, Mi, Do, Fr und So ein, also alle Tage außer Mo und Sa. Wir errechnen den erweiterten Durchschnitt scheibenweise:
df_naiv <- df_naiv %>% mutate(Umsatz_glDS_3T_erw = 0) # initialisiere neue Variable

# speichere die 1. Scheibe in Umsatz_temp zwischen
df_naiv <- df_naiv %>% mutate(Umsatz_temp = Umsatz_lag_1T * (df_naiv$Wochentag_c != "Montag" & df_naiv$Wochentag_c != "Samstag"))

# Zwischenschritt: ersetze NA durch 0
df_naiv <- df_naiv %>%
  mutate(Umsatz_temp = replace_na(Umsatz_temp, 0))

# übernehme das Zwischenergebnis in die Zielvariable Umsatz_glDS_3T_erw, mit Faktor 1/3
df_naiv <- df_naiv %>% mutate(Umsatz_glDS_3T_erw = Umsatz_glDS_3T_erw + (Umsatz_temp / 3))

# speichere die 2. Scheibe in Umsatz_temp zwischen
df_naiv <- df_naiv %>% mutate(Umsatz_temp = Umsatz_lag_2T * (df_naiv$Wochentag_c == "Mittwoch" | df_naiv$Wochentag_c == "Donnerstag" | df_naiv$Wochentag_c == "Freitag"))

# Zwischenschritt: ersetze NA durch 0
df_naiv <- df_naiv %>%
  mutate(Umsatz_temp = replace_na(Umsatz_temp, 0))

# übernehme das Zwischenergebnis in die Zielvariable Umsatz_glDS_3T_erw, mit Faktor 1/3
df_naiv <- df_naiv %>% mutate(Umsatz_glDS_3T_erw = Umsatz_glDS_3T_erw + (Umsatz_temp / 3))

# speichere die 3. Scheibe in Umsatz_temp zwischen
df_naiv <- df_naiv %>% mutate(Umsatz_temp = Umsatz_lag_3T * (df_naiv$Wochentag_c == "Montag" | df_naiv$Wochentag_c == "Donnerstag" | df_naiv$Wochentag_c == "Freitag"))

# Zwischenschritt: ersetze NA durch 0
df_naiv <- df_naiv %>%
  mutate(Umsatz_temp = replace_na(Umsatz_temp, 0))

# übernehme das Zwischenergebnis in die Zielvariable Umsatz_glDS_3T_erw, mit Faktor 1/3
df_naiv <- df_naiv %>% mutate(Umsatz_glDS_3T_erw = Umsatz_glDS_3T_erw + (Umsatz_temp / 3))

# speichere die 4. Scheibe in Umsatz_temp zwischen
df_naiv <- df_naiv %>% mutate(Umsatz_temp = Umsatz_lag_4T * (df_naiv$Wochentag_c == "Montag" | df_naiv$Wochentag_c == "Dienstag"))

# Zwischenschritt: ersetze NA durch 0
df_naiv <- df_naiv %>%
  mutate(Umsatz_temp = replace_na(Umsatz_temp, 0))

# übernehme das Zwischenergebnis in die Zielvariable Umsatz_glDS_3T_erw, mit Faktor 1/3
df_naiv <- df_naiv %>% mutate(Umsatz_glDS_3T_erw = Umsatz_glDS_3T_erw + (Umsatz_temp / 3))

# speichere die 5. Scheibe in Umsatz_temp zwischen
df_naiv <- df_naiv %>% mutate(Umsatz_temp = Umsatz_lag_5T * (df_naiv$Wochentag_c == "Montag" | df_naiv$Wochentag_c == "Dienstag" | df_naiv$Wochentag_c == "Mittwoch"))

# Zwischenschritt: ersetze NA durch 0
df_naiv <- df_naiv %>%
  mutate(Umsatz_temp = replace_na(Umsatz_temp, 0))

# übernehme das Zwischenergebnis in die Zielvariable Umsatz_glDS_3T_erw, mit Faktor 1/3
df_naiv <- df_naiv %>% mutate(Umsatz_glDS_3T_erw = Umsatz_glDS_3T_erw + (Umsatz_temp / 3))

# speichere die 6. Scheibe in Umsatz_temp zwischen
df_naiv <- df_naiv %>% mutate(Umsatz_temp = Umsatz_lag_6T * (df_naiv$Wochentag_c == "Samstag"))

# Zwischenschritt: ersetze NA durch 0
df_naiv <- df_naiv %>%
  mutate(Umsatz_temp = replace_na(Umsatz_temp, 0))

# übernehme das Zwischenergebnis in die Zielvariable Umsatz_glDS_3T_erw, mit Faktor 1/3
df_naiv <- df_naiv %>% mutate(Umsatz_glDS_3T_erw = Umsatz_glDS_3T_erw + (Umsatz_temp / 3))

# speichere die 7. Scheibe in Umsatz_temp zwischen
df_naiv <- df_naiv %>% mutate(Umsatz_temp = Umsatz_lag_7T * (df_naiv$Wochentag_c == "Samstag" | df_naiv$Wochentag_c == "Sonntag"))

# Zwischenschritt: ersetze NA durch 0
df_naiv <- df_naiv %>%
  mutate(Umsatz_temp = replace_na(Umsatz_temp, 0))

# übernehme das Zwischenergebnis in die Zielvariable Umsatz_glDS_3T_erw, mit Faktor 1/3
df_naiv <- df_naiv %>% mutate(Umsatz_glDS_3T_erw = Umsatz_glDS_3T_erw + (Umsatz_temp / 3))

# speichere die 8. Scheibe in Umsatz_temp zwischen
df_naiv <- df_naiv %>% mutate(Umsatz_temp = Umsatz_lag_8T * (df_naiv$Wochentag_c == "Sonntag"))

# Zwischenschritt: ersetze NA durch 0
df_naiv <- df_naiv %>%
  mutate(Umsatz_temp = replace_na(Umsatz_temp, 0))

# übernehme das Zwischenergebnis in die Zielvariable Umsatz_glDS_3T_erw, mit Faktor 1/3
df_naiv <- df_naiv %>% mutate(Umsatz_glDS_3T_erw = Umsatz_glDS_3T_erw + (Umsatz_temp / 3))

# speichere die 13. Scheibe in Umsatz_temp zwischen
df_naiv <- df_naiv %>% mutate(Umsatz_temp = Umsatz_lag_13T * (df_naiv$Wochentag_c == "Samstag"))

# Zwischenschritt: ersetze NA durch 0
df_naiv <- df_naiv %>%
  mutate(Umsatz_temp = replace_na(Umsatz_temp, 0))

# übernehme das Zwischenergebnis in die Zielvariable Umsatz_glDS_3T_erw, mit Faktor 1/3
df_naiv <- df_naiv %>% mutate(Umsatz_glDS_3T_erw = Umsatz_glDS_3T_erw + (Umsatz_temp / 3))

# Prüfung: df_naiv %>% filter(is.na(Umsatz_glDS_3T_erw))
# Wir wiederholen das Vorgehen, um noch den Durchschnitt der letzten 4 Wochentage bzw. Wochenendtage ermitteln. Für einen Montag müssen wir also 3, 4, 5 und 6 Tage zurück gehen, für einen Samstag 6, 7, 13 und 14 Tage. Oder anders ausgedrückt: Der Umsatz 1 Tag zurück (Umsatz_lag_1T) fließt in die Berechnung des erweiterten Durchschnitts für die Tage Di, Mi, Do, Fr und So ein, also alle Tage außer Mo und Sa. Wir errechnen den erweiterten Durchschnitt scheibenweise:
df_naiv <- df_naiv %>% mutate(Umsatz_glDS_4T_erw = 0) # initialisiere neue Variable

# speichere die 1. Scheibe in Umsatz_temp zwischen
df_naiv <- df_naiv %>% mutate(Umsatz_temp = Umsatz_lag_1T * (df_naiv$Wochentag_c != "Montag" & df_naiv$Wochentag_c != "Samstag"))

# Zwischenschritt: ersetze NA durch 0
df_naiv <- df_naiv %>%
  mutate(Umsatz_temp = replace_na(Umsatz_temp, 0))

# übernehme das Zwischenergebnis in die Zielvariable Umsatz_glDS_4T_erw, mit Faktor 1/4
df_naiv <- df_naiv %>% mutate(Umsatz_glDS_4T_erw = Umsatz_glDS_4T_erw + (Umsatz_temp / 4))

# speichere die 2. Scheibe in Umsatz_temp zwischen
df_naiv <- df_naiv %>% mutate(Umsatz_temp = Umsatz_lag_2T * (df_naiv$Wochentag_c == "Mittwoch" | df_naiv$Wochentag_c == "Donnerstag" | df_naiv$Wochentag_c == "Freitag"))

# Zwischenschritt: ersetze NA durch 0
df_naiv <- df_naiv %>%
  mutate(Umsatz_temp = replace_na(Umsatz_temp, 0))

# übernehme das Zwischenergebnis in die Zielvariable Umsatz_glDS_4T_erw, mit Faktor 1/4
df_naiv <- df_naiv %>% mutate(Umsatz_glDS_4T_erw = Umsatz_glDS_4T_erw + (Umsatz_temp / 4))

# speichere die 3. Scheibe in Umsatz_temp zwischen
df_naiv <- df_naiv %>% mutate(Umsatz_temp = Umsatz_lag_3T * (df_naiv$Wochentag_c == "Montag" | df_naiv$Wochentag_c == "Donnerstag" | df_naiv$Wochentag_c == "Freitag"))

# Zwischenschritt: ersetze NA durch 0
df_naiv <- df_naiv %>%
  mutate(Umsatz_temp = replace_na(Umsatz_temp, 0))

# übernehme das Zwischenergebnis in die Zielvariable Umsatz_glDS_4T_erw, mit Faktor 1/4
df_naiv <- df_naiv %>% mutate(Umsatz_glDS_4T_erw = Umsatz_glDS_4T_erw + (Umsatz_temp / 4))

# speichere die 4. Scheibe in Umsatz_temp zwischen
df_naiv <- df_naiv %>% mutate(Umsatz_temp = Umsatz_lag_4T * (df_naiv$Wochentag_c == "Montag" | df_naiv$Wochentag_c == "Dienstag" | df_naiv$Wochentag_c == "Freitag"))

# Zwischenschritt: ersetze NA durch 0
df_naiv <- df_naiv %>%
  mutate(Umsatz_temp = replace_na(Umsatz_temp, 0))

# übernehme das Zwischenergebnis in die Zielvariable Umsatz_glDS_4T_erw, mit Faktor 1/4
df_naiv <- df_naiv %>% mutate(Umsatz_glDS_4T_erw = Umsatz_glDS_4T_erw + (Umsatz_temp / 4))

# speichere die 5. Scheibe in Umsatz_temp zwischen
df_naiv <- df_naiv %>% mutate(Umsatz_temp = Umsatz_lag_5T * (df_naiv$Wochentag_c == "Montag" | df_naiv$Wochentag_c == "Dienstag" | df_naiv$Wochentag_c == "Mittwoch"))

# Zwischenschritt: ersetze NA durch 0
df_naiv <- df_naiv %>%
  mutate(Umsatz_temp = replace_na(Umsatz_temp, 0))

# übernehme das Zwischenergebnis in die Zielvariable Umsatz_glDS_4T_erw, mit Faktor 1/4
df_naiv <- df_naiv %>% mutate(Umsatz_glDS_4T_erw = Umsatz_glDS_4T_erw + (Umsatz_temp / 4))

# speichere die 6. Scheibe in Umsatz_temp zwischen
df_naiv <- df_naiv %>% mutate(Umsatz_temp = Umsatz_lag_1T * (df_naiv$Wochentag_c != "Freitag" & df_naiv$Wochentag_c != "Sonntag"))

# Zwischenschritt: ersetze NA durch 0
df_naiv <- df_naiv %>%
  mutate(Umsatz_temp = replace_na(Umsatz_temp, 0))

# übernehme das Zwischenergebnis in die Zielvariable Umsatz_glDS_4T_erw, mit Faktor 1/4
df_naiv <- df_naiv %>% mutate(Umsatz_glDS_4T_erw = Umsatz_glDS_4T_erw + (Umsatz_temp / 4))

# speichere die 7. Scheibe in Umsatz_temp zwischen
df_naiv <- df_naiv %>% mutate(Umsatz_temp = Umsatz_lag_7T * (df_naiv$Wochentag_c == "Samstag" | df_naiv$Wochentag_c == "Sonntag"))

# Zwischenschritt: ersetze NA durch 0
df_naiv <- df_naiv %>%
  mutate(Umsatz_temp = replace_na(Umsatz_temp, 0))

# übernehme das Zwischenergebnis in die Zielvariable Umsatz_glDS_4T_erw, mit Faktor 1/4
df_naiv <- df_naiv %>% mutate(Umsatz_glDS_4T_erw = Umsatz_glDS_4T_erw + (Umsatz_temp / 4))

# speichere die 8. Scheibe in Umsatz_temp zwischen
df_naiv <- df_naiv %>% mutate(Umsatz_temp = Umsatz_lag_8T * (df_naiv$Wochentag_c == "Sonntag"))

# Zwischenschritt: ersetze NA durch 0
df_naiv <- df_naiv %>%
  mutate(Umsatz_temp = replace_na(Umsatz_temp, 0))

# übernehme das Zwischenergebnis in die Zielvariable Umsatz_glDS_4T_erw, mit Faktor 1/4
df_naiv <- df_naiv %>% mutate(Umsatz_glDS_4T_erw = Umsatz_glDS_4T_erw + (Umsatz_temp / 4))

# speichere die 13. Scheibe in Umsatz_temp zwischen
df_naiv <- df_naiv %>% mutate(Umsatz_temp = Umsatz_lag_13T * (df_naiv$Wochentag_c == "Samstag"))

# Zwischenschritt: ersetze NA durch 0
df_naiv <- df_naiv %>%
  mutate(Umsatz_temp = replace_na(Umsatz_temp, 0))

# übernehme das Zwischenergebnis in die Zielvariable Umsatz_glDS_4T_erw, mit Faktor 1/4
df_naiv <- df_naiv %>% mutate(Umsatz_glDS_4T_erw = Umsatz_glDS_4T_erw + (Umsatz_temp / 4))

# speichere die 14. Scheibe in Umsatz_temp zwischen
df_naiv <- df_naiv %>% mutate(Umsatz_temp = Umsatz_lag_14T * (df_naiv$Wochentag_c == "Samstag" | df_naiv$Wochentag_c == "Sonntag"))

# Zwischenschritt: ersetze NA durch 0
df_naiv <- df_naiv %>%
  mutate(Umsatz_temp = replace_na(Umsatz_temp, 0))

# übernehme das Zwischenergebnis in die Zielvariable Umsatz_glDS_4T_erw, mit Faktor 1/4
df_naiv <- df_naiv %>% mutate(Umsatz_glDS_4T_erw = Umsatz_glDS_4T_erw + (Umsatz_temp / 4))

Unsere Schätzung machen wir nur für Tage, für die Umsatzdaten in den Rohdaten vorlagen (Umsatz_NA = FALSE). Und für die einzelnen Modelle beginnt die Schätzung erst ab dem Zeitpunkt, ab dem Vorwochenwerte vorliegen. Für die Verwendung des gewichteten MIttelwertes der letzten 4 Wochen können wir bspw. erst ab dem 29. Tag schätzen. Alle anderen Schätzer liegen schon früher vor. Für die Vergleichbarkeit der Modelle starten wir daher einheitlich ab dem 01.08.2013 (also sogar erst 31 Tage nach Beginn der Zeitreihe).

5.3 Prognose der Umsätze anhand des Vorwochenwertes

Für die Schätzung und die anschließende Ermittlung der Gütemaße verwenden wir einen eigenen Datensatz prog_naiv_lag_1W.

## # A tibble: 10 x 4
## # Groups:   Warengruppe [5]
##    Warengruppe Prognose_zuhoch Anteil_abs Anteil_rel
##          <dbl> <lgl>                <int>      <dbl>
##  1           1 FALSE                 1059         49
##  2           1 TRUE                  1086         51
##  3           2 FALSE                 1054         49
##  4           2 TRUE                  1091         51
##  5           3 FALSE                 1061         49
##  6           3 TRUE                  1084         51
##  7           4 FALSE                 1023         49
##  8           4 TRUE                  1075         51
##  9           5 FALSE                 1060         49
## 10           5 TRUE                  1085         51
## # A tibble: 5 x 10
##   Warengruppe Anzahl mittlUmsatz mittlAbw StdAbw mittlAbw_abs mittlAbw_rel
##         <dbl>  <int>       <dbl>    <dbl>  <dbl>        <dbl>        <dbl>
## 1           1   2145       125.   -0.0664   41.4         29.9           24
## 2           2   2145       399.    0.204    85.1         58.2           15
## 3           3   2145       166.   -0.0511   45.3         32.9           20
## 4           4   2098        87.2   0.0784   32.5         23.3           27
## 5           5   2145       277.    0.354   125.          53.3           19
## # ... with 3 more variables: mittlAbw_quad <dbl>, Abweichung_Q5 <dbl>,
## #   Abweichung_Q95 <dbl>

Die Verteilung der relativen Abweichung erscheint sehr breit. Unser naiver Schätzer auf Basis des Vorwochenwertes liefert also keine gute Umsatzprognose. Augenscheinlich gibt es einige Prognosewerte, die deutlich zu hoch sind. Diese Ausreißer wollen wir nun näher untersuchen, um zu verstehen, an welchen Stellen unser Modell noch Probleme hat. Für die Untersuchung der Prognosegüte hatten wir den Datensatz prog_naiv_lag_1W erstellt, mit dem wir jetzt weiter arbeiten.

## # A tibble: 5 x 2
##   Warengruppe Anzahl
##         <dbl>  <int>
## 1           1     46
## 2           2     11
## 3           3     19
## 4           4     53
## 5           5      9
## # A tibble: 3 x 3
## # Groups:   Warengruppe [2]
##   Warengruppe Feiertag Anzahl
##         <dbl>    <dbl>  <int>
## 1           1        0     36
## 2           1        1     10
## 3           4        0     53
## # A tibble: 7 x 2
##   Wochentag_c Anzahl
##   <chr>        <int>
## 1 Dienstag         7
## 2 Donnerstag      25
## 3 Freitag          8
## 4 Mittwoch        20
## 5 Montag          33
## 6 Samstag         25
## 7 Sonntag         20

Für Dienstage und Freitage scheint unser naiver Schätzer nur selten eine deutlich zu hohe Prognose zu liefern. Ansonsten sind keine Unterschiede zu erkennen.

Wir werfen nun einen Blick auf die Top10 Abweichungen (Abweichung_rel) nach oben und nach unten: Für welche Tage liegt der Schätzer auf Basis des Vorwochenwertes besonders weit daneben? Oder gibt es Warengruppen, für die der Schätzer besonders viele große Ausreißer aufweist?

## # A tibble: 10 x 59
## # Groups:   Warengruppe [3]
##    Datum      Warengruppe Umsatz  Jahr KielerWoche Bewoelkung Temperatur
##    <date>           <dbl>  <dbl> <dbl>       <dbl>      <dbl>      <dbl>
##  1 2016-12-31           5 1705.   2016           0          7        4.9
##  2 2017-12-31           5 1432.   2017           0          7        8.2
##  3 2014-12-31           5 1879.   2014           0          6        7.4
##  4 2015-12-31           5 1870.   2015           0          7        2  
##  5 2013-12-31           5 1626.   2013           0          4        5  
##  6 2016-02-04           4  213.   2016           0          5        4.2
##  7 2018-12-31           5 1668.   2018           0          7        7.4
##  8 2017-04-24           1   92.5  2017           0          7        8.9
##  9 2017-05-25           4  179.   2017           0          2       18.9
## 10 2016-05-16           4  221.   2016           0          5       11.2
## # ... with 52 more variables: Windgeschwindigkeit <dbl>, Wochentag <dbl>,
## #   Monat <dbl>, Wochentag_c <chr>, Monat_c <chr>, Wochenende <dbl>,
## #   SommerferienSH <dbl>, SommerferienNRW <dbl>, SommerferienNDS <dbl>,
## #   SommerferienHE <dbl>, Feiertag <dbl>, Ostern <dbl>,
## #   ChristiHimmelfahrt <dbl>, Pfingsten <dbl>, TDE <dbl>, Silvester <dbl>,
## #   Ostern_ext <dbl>, ChristiHimmelfahrt_ext <dbl>, Pfingsten_ext <dbl>,
## #   Silvester_ext <dbl>, Jahreszeit <chr>, Fruehling <dbl>, Sommer <dbl>,
## #   Herbst <dbl>, Winter <dbl>, Umsatz_NA <lgl>, Umsatz_lag_1W <dbl>,
## #   Umsatz_lag_2W <dbl>, Umsatz_lag_3W <dbl>, Umsatz_lag_4W <dbl>,
## #   Umsatz_lag <dbl>, Umsatz_gewMW_4W <dbl>, Umsatz_lag_1T <dbl>,
## #   Umsatz_lag_2T <dbl>, Umsatz_lag_3T <dbl>, Umsatz_lag_4T <dbl>,
## #   Umsatz_lag_5T <dbl>, Umsatz_lag_6T <dbl>, Umsatz_lag_7T <dbl>,
## #   Umsatz_lag_8T <dbl>, Umsatz_lag_13T <dbl>, Umsatz_lag_14T <dbl>,
## #   Umsatz_glDS_3T <dbl>, Umsatz_glDS_3T_erw <dbl>, Umsatz_temp <dbl>,
## #   Umsatz_glDS_4T_erw <dbl>, Prognose_zuhoch <lgl>, Abweichung <dbl>,
## #   Abweichung_abs <dbl>, Abweichung_rel <dbl>, Abweichung_quad <dbl>,
## #   Anzahl <int>
## # A tibble: 10 x 59
## # Groups:   Warengruppe [3]
##    Datum      Warengruppe Umsatz  Jahr KielerWoche Bewoelkung Temperatur
##    <date>           <dbl>  <dbl> <dbl>       <dbl>      <dbl>      <dbl>
##  1 2014-03-02           4  108.   2014           0          6        6.6
##  2 2017-01-07           1   71.7  2017           0          8       -0.5
##  3 2018-01-07           5  316.   2018           0          0        0.6
##  4 2017-04-22           1   81.4  2017           0          5        7.5
##  5 2017-01-07           5  266.   2017           0          8       -0.5
##  6 2019-01-07           5  250.   2019           0          8        5.9
##  7 2017-04-17           1   23.2  2017           0          6        6.2
##  8 2015-01-07           5  263.   2015           0          6        5.8
##  9 2014-01-07           5  211.   2014           0          7       10.4
## 10 2016-01-07           5  212.   2016           0          7       -4  
## # ... with 52 more variables: Windgeschwindigkeit <dbl>, Wochentag <dbl>,
## #   Monat <dbl>, Wochentag_c <chr>, Monat_c <chr>, Wochenende <dbl>,
## #   SommerferienSH <dbl>, SommerferienNRW <dbl>, SommerferienNDS <dbl>,
## #   SommerferienHE <dbl>, Feiertag <dbl>, Ostern <dbl>,
## #   ChristiHimmelfahrt <dbl>, Pfingsten <dbl>, TDE <dbl>, Silvester <dbl>,
## #   Ostern_ext <dbl>, ChristiHimmelfahrt_ext <dbl>, Pfingsten_ext <dbl>,
## #   Silvester_ext <dbl>, Jahreszeit <chr>, Fruehling <dbl>, Sommer <dbl>,
## #   Herbst <dbl>, Winter <dbl>, Umsatz_NA <lgl>, Umsatz_lag_1W <dbl>,
## #   Umsatz_lag_2W <dbl>, Umsatz_lag_3W <dbl>, Umsatz_lag_4W <dbl>,
## #   Umsatz_lag <dbl>, Umsatz_gewMW_4W <dbl>, Umsatz_lag_1T <dbl>,
## #   Umsatz_lag_2T <dbl>, Umsatz_lag_3T <dbl>, Umsatz_lag_4T <dbl>,
## #   Umsatz_lag_5T <dbl>, Umsatz_lag_6T <dbl>, Umsatz_lag_7T <dbl>,
## #   Umsatz_lag_8T <dbl>, Umsatz_lag_13T <dbl>, Umsatz_lag_14T <dbl>,
## #   Umsatz_glDS_3T <dbl>, Umsatz_glDS_3T_erw <dbl>, Umsatz_temp <dbl>,
## #   Umsatz_glDS_4T_erw <dbl>, Prognose_zuhoch <lgl>, Abweichung <dbl>,
## #   Abweichung_abs <dbl>, Abweichung_rel <dbl>, Abweichung_quad <dbl>,
## #   Anzahl <int>

Für Silvester liefert unser naiver Schätzer auf Basis des Vorwochenwertes offenbar systematisch zu niedrige Prognosen, besonders für Warengruppe 5 (Kuchen), was vermutlich am Verkauf der Berliner liegt. Das war zu erwarten, weil Silvester immer sehr umsatzstarke Tage sind. Ebenso liefert das Modell für den 7. Januar konsequent zu hohe Schätzwerte, weil diese auf Basis der sehr hohen Silvester-Umsätze prognostiziert werden.

5.4 Prognose der Umsätze anhand des gleitenden Durchschnitts

In diesem Abschnitt betrachten wir die Schätzung mittels eines gleitenden Durchschnitts über die letzten 3 Tage (Umsatz_glDS_3T). Wir wissen bereits, dass der Umsatz am Wochenende systematisch höher ist, als unter der Woche. Daher erwarten wir, dass der gleitende Durchschnitt in der Form nur eingeschränkt geeignet ist, wahrscheinlich nur Für Donnerstag und Freitag.

Als Erweiterung wollen wir den Umsatz für Wochentage auf Basis des Durchschnitts der letzten drei Wochentage schätzen und den Umsatz für Wochenendtage auf Basis der letzten drei Wochenendtage (Umsatz_glDS_3T_erw). Und am Ende erweitern wir dieses Vorgehen sogar noch um einen Tag (Umsatz_glDS_4T_erw) und beziehen die letzten vier Wochen- bzw. Wochenendtage in die Prognose ein.

Gleitender Durchschnitt der letzten 3 Tage

Für die Schätzung und die anschließende Ermittlung der Gütemaße verwenden wir eigene Datensätze prog_naiv_glDS_3T und prog_naiv_glDS_3T_erw bzw. prog_naiv_glDS_4T_erw. Wir starten wieder am 01.08.2013, um die Vergleichbarkeit der naiven Modelle zu wahren.

## # A tibble: 10 x 4
## # Groups:   Warengruppe [5]
##    Warengruppe Prognose_zuhoch Anteil_abs Anteil_rel
##          <dbl> <lgl>                <int>      <dbl>
##  1           1 FALSE                 1183         55
##  2           1 TRUE                   962         45
##  3           2 FALSE                 1047         49
##  4           2 TRUE                  1098         51
##  5           3 FALSE                 1008         47
##  6           3 TRUE                  1137         53
##  7           4 FALSE                  938         45
##  8           4 TRUE                  1160         55
##  9           5 FALSE                 1065         50
## 10           5 TRUE                  1080         50
## # A tibble: 5 x 10
##   Warengruppe Anzahl mittlUmsatz mittlAbw StdAbw mittlAbw_abs mittlAbw_rel
##         <dbl>  <int>       <dbl>    <dbl>  <dbl>        <dbl>        <dbl>
## 1           1   2145       125.    -0.755   41.8         30.6           25
## 2           2   2145       399.    -1.99   108.          86.2           22
## 3           3   2145       166.    -0.767   51.6         39.8           24
## 4           4   2098        87.2   -0.197   36.6         26.0           30
## 5           5   2145       277.    -2.05    99.2         49.0           18
## # ... with 3 more variables: mittlAbw_quad <dbl>, Abweichung_Q5 <dbl>,
## #   Abweichung_Q95 <dbl>

Die Verteilung der relativen Abweichung erscheint ebenfalls sehr breit. Unser naiver Schätzer auf Basis des gleitenden Durchschnitts der letzten 3 Tage liefert also keine gute Umsatzprognose. Augenscheinlich gibt es einige Prognosewerte, die deutlich zu hoch sind. Diese Ausreißer wollen wir nun näher untersuchen, um zu verstehen, an welchen Stellen unser Modell noch Probleme hat. Für die Untersuchung der Prognosegüte hatten wir den Datensatz prog_naiv_glDS_3T erstellt, mit dem wir jetzt weiter arbeiten.

## # A tibble: 5 x 2
##   Warengruppe Anzahl
##         <dbl>  <int>
## 1           1    132
## 2           2      1
## 3           3     19
## 4           4     60
## 5           5     14
## # A tibble: 4 x 3
## # Groups:   Warengruppe [2]
##   Warengruppe Feiertag Anzahl
##         <dbl>    <dbl>  <int>
## 1           1        0    113
## 2           1        1     19
## 3           4        0     59
## 4           4        1      1
## # A tibble: 7 x 2
##   Wochentag_c Anzahl
##   <chr>        <int>
## 1 Dienstag        26
## 2 Donnerstag       8
## 3 Freitag          5
## 4 Mittwoch        23
## 5 Montag          38
## 6 Samstag          7
## 7 Sonntag        119

Wie erwartet funktioniert das Modell für die Tage Donnerstag und Freitag sehr gut, weil für diese Tage die Schätzung keine Wochenendtage einbezieht. Offenbar funktioniert das auch für den Samstag relativ gut. Für die übrigen Tage gibt es Probleme.

Wir werfen nun einen Blick auf die Top10 Abweichungen (Abweichung_rel) nach oben und nach unten: Für welche Tage liegt der Schätzer auf Basis des Vorwochenwertes besonders weit daneben? Oder gibt es Warengruppen, für die der Schätzer besonders viele große Ausreißer aufweist?

## # A tibble: 10 x 59
## # Groups:   Warengruppe [2]
##    Datum      Warengruppe Umsatz  Jahr KielerWoche Bewoelkung Temperatur
##    <date>           <dbl>  <dbl> <dbl>       <dbl>      <dbl>      <dbl>
##  1 2015-12-31           5  1870.  2015           0          7        2  
##  2 2014-12-31           5  1879.  2014           0          6        7.4
##  3 2016-12-31           5  1705.  2016           0          7        4.9
##  4 2013-12-31           5  1626.  2013           0          4        5  
##  5 2018-12-31           5  1668.  2018           0          7        7.4
##  6 2017-12-31           5  1432.  2017           0          7        8.2
##  7 2013-11-17           4   177.  2013           0          2        8.9
##  8 2014-02-23           4   430.  2014           0          1        8.6
##  9 2015-02-01           4   215.  2015           0          7       -0.2
## 10 2017-01-15           4   230.  2017           0          5        1.4
## # ... with 52 more variables: Windgeschwindigkeit <dbl>, Wochentag <dbl>,
## #   Monat <dbl>, Wochentag_c <chr>, Monat_c <chr>, Wochenende <dbl>,
## #   SommerferienSH <dbl>, SommerferienNRW <dbl>, SommerferienNDS <dbl>,
## #   SommerferienHE <dbl>, Feiertag <dbl>, Ostern <dbl>,
## #   ChristiHimmelfahrt <dbl>, Pfingsten <dbl>, TDE <dbl>, Silvester <dbl>,
## #   Ostern_ext <dbl>, ChristiHimmelfahrt_ext <dbl>, Pfingsten_ext <dbl>,
## #   Silvester_ext <dbl>, Jahreszeit <chr>, Fruehling <dbl>, Sommer <dbl>,
## #   Herbst <dbl>, Winter <dbl>, Umsatz_NA <lgl>, Umsatz_lag_1W <dbl>,
## #   Umsatz_lag_2W <dbl>, Umsatz_lag_3W <dbl>, Umsatz_lag_4W <dbl>,
## #   Umsatz_lag <dbl>, Umsatz_gewMW_4W <dbl>, Umsatz_lag_1T <dbl>,
## #   Umsatz_lag_2T <dbl>, Umsatz_lag_3T <dbl>, Umsatz_lag_4T <dbl>,
## #   Umsatz_lag_5T <dbl>, Umsatz_lag_6T <dbl>, Umsatz_lag_7T <dbl>,
## #   Umsatz_lag_8T <dbl>, Umsatz_lag_13T <dbl>, Umsatz_lag_14T <dbl>,
## #   Umsatz_glDS_3T <dbl>, Umsatz_glDS_3T_erw <dbl>, Umsatz_temp <dbl>,
## #   Umsatz_glDS_4T_erw <dbl>, Prognose_zuhoch <lgl>, Abweichung <dbl>,
## #   Abweichung_abs <dbl>, Abweichung_rel <dbl>, Abweichung_quad <dbl>,
## #   Anzahl <int>
## # A tibble: 10 x 59
## # Groups:   Warengruppe [3]
##    Datum      Warengruppe Umsatz  Jahr KielerWoche Bewoelkung Temperatur
##    <date>           <dbl>  <dbl> <dbl>       <dbl>      <dbl>      <dbl>
##  1 2015-04-19           1   25.5  2015           0          0       10.1
##  2 2017-01-17           4   37.2  2017           0          7        0.5
##  3 2014-02-24           4   57.8  2014           0          1        9.4
##  4 2014-04-20           1   57.8  2014           0          0       13.9
##  5 2016-01-03           5  190.   2016           0          7       -5.5
##  6 2015-11-22           1   24.8  2015           0          7        2.2
##  7 2018-04-01           1   68.3  2018           0          6        2.5
##  8 2018-04-02           1   43.2  2018           0          5        6.1
##  9 2015-10-18           1   23.1  2015           0          8       11.1
## 10 2017-04-17           1   23.2  2017           0          6        6.2
## # ... with 52 more variables: Windgeschwindigkeit <dbl>, Wochentag <dbl>,
## #   Monat <dbl>, Wochentag_c <chr>, Monat_c <chr>, Wochenende <dbl>,
## #   SommerferienSH <dbl>, SommerferienNRW <dbl>, SommerferienNDS <dbl>,
## #   SommerferienHE <dbl>, Feiertag <dbl>, Ostern <dbl>,
## #   ChristiHimmelfahrt <dbl>, Pfingsten <dbl>, TDE <dbl>, Silvester <dbl>,
## #   Ostern_ext <dbl>, ChristiHimmelfahrt_ext <dbl>, Pfingsten_ext <dbl>,
## #   Silvester_ext <dbl>, Jahreszeit <chr>, Fruehling <dbl>, Sommer <dbl>,
## #   Herbst <dbl>, Winter <dbl>, Umsatz_NA <lgl>, Umsatz_lag_1W <dbl>,
## #   Umsatz_lag_2W <dbl>, Umsatz_lag_3W <dbl>, Umsatz_lag_4W <dbl>,
## #   Umsatz_lag <dbl>, Umsatz_gewMW_4W <dbl>, Umsatz_lag_1T <dbl>,
## #   Umsatz_lag_2T <dbl>, Umsatz_lag_3T <dbl>, Umsatz_lag_4T <dbl>,
## #   Umsatz_lag_5T <dbl>, Umsatz_lag_6T <dbl>, Umsatz_lag_7T <dbl>,
## #   Umsatz_lag_8T <dbl>, Umsatz_lag_13T <dbl>, Umsatz_lag_14T <dbl>,
## #   Umsatz_glDS_3T <dbl>, Umsatz_glDS_3T_erw <dbl>, Umsatz_temp <dbl>,
## #   Umsatz_glDS_4T_erw <dbl>, Prognose_zuhoch <lgl>, Abweichung <dbl>,
## #   Abweichung_abs <dbl>, Abweichung_rel <dbl>, Abweichung_quad <dbl>,
## #   Anzahl <int>

Für Silvester liefert unser naiver Schätzer auf Basis des gleitenden Durchschnitts offenbar systematisch zu niedrige Prognosen, besonders für Warengruppe 5 (Kuchen), was vermutlich am Verkauf der Berliner liegt. Das war zu erwarten, weil Silvester immer sehr umsatzstarke Tage sind. Für die Tage mit deutlich zu hoher Prognose ist auf den ersten Blick keine Systematik zu erkennen.

Erweiterter gl. Durchschnitt der letzten 3 Wochen- bzw. Wochenendtage

Als Erweiterung wollen wir den Umsatz für Wochentage auf Basis des Durchschnitts der letzten drei Wochentage schätzen und den Umsatz für Wochenendtage auf Basis der letzten drei Wochenendtage (Umsatz_glDS_3T_erw).

Für die Schätzung und die anschließende Ermittlung der Gütemaße verwenden wir einen eigenen Datensatz prog_naiv_glDS_3T_erw. Wir starten wieder am 01.08.2013, um die Vergleichbarkeit der naiven Modelle zu wahren.

## # A tibble: 10 x 4
## # Groups:   Warengruppe [5]
##    Warengruppe Prognose_zuhoch Anteil_abs Anteil_rel
##          <dbl> <lgl>                <int>      <dbl>
##  1           1 FALSE                 1061         49
##  2           1 TRUE                  1084         51
##  3           2 FALSE                 1066         50
##  4           2 TRUE                  1079         50
##  5           3 FALSE                 1058         49
##  6           3 TRUE                  1087         51
##  7           4 FALSE                  996         47
##  8           4 TRUE                  1102         53
##  9           5 FALSE                 1052         49
## 10           5 TRUE                  1093         51
## # A tibble: 5 x 10
##   Warengruppe Anzahl mittlUmsatz mittlAbw StdAbw mittlAbw_abs mittlAbw_rel
##         <dbl>  <int>       <dbl>    <dbl>  <dbl>        <dbl>        <dbl>
## 1           1   2145       125.   -0.720    43.5         32.2           26
## 2           2   2145       399.   -1.34     69.2         48.2           12
## 3           3   2145       166.   -0.510    35.5         25.5           15
## 4           4   2098        87.2  -0.0883   31.7         22.4           26
## 5           5   2145       277.   -1.53     97.4         43.5           16
## # ... with 3 more variables: mittlAbw_quad <dbl>, Abweichung_Q5 <dbl>,
## #   Abweichung_Q95 <dbl>

Die Verteilung der relativen Abweichung erscheint deutlich schmaler. Unser naiver Schätzer auf Basis des erweiterten gleitenden Durchschnitts der letzten 3 Wochentage (für Mo bis Fr) bzw. Wochenendtage (für Sa und So) liefert eine treffendere Umsatzprognose. Augenscheinlich gibt es aber immer noch einige Prognosewerte, die deutlich zu hoch sind. Diese Ausreißer wollen wir nun näher untersuchen, um zu verstehen, an welchen Stellen unser Modell noch Probleme hat. Für die Untersuchung der Prognosegüte hatten wir den Datensatz prog_naiv_glDS_3T_erw erstellt, mit dem wir jetzt weiter arbeiten.

## # A tibble: 4 x 2
##   Warengruppe Anzahl
##         <dbl>  <int>
## 1           1    107
## 2           3      4
## 3           4     42
## 4           5     14
## # A tibble: 4 x 3
## # Groups:   Warengruppe [2]
##   Warengruppe Feiertag Anzahl
##         <dbl>    <dbl>  <int>
## 1           1        0     90
## 2           1        1     17
## 3           4        0     41
## 4           4        1      1
## # A tibble: 7 x 2
##   Wochentag_c Anzahl
##   <chr>        <int>
## 1 Dienstag         8
## 2 Donnerstag       8
## 3 Freitag          5
## 4 Mittwoch         7
## 5 Montag          11
## 6 Samstag         37
## 7 Sonntag         91

Das Modell funktioniert - wie erwartet - deutlich besser für alle Wochentage Mo bis Fr. Allerdings gibt es offenbar noch Schwachstellen für das Wochenende: Besonders die Schätzung für Sonntage liegt auffällig oft deutlich zu hoch.

Wir werfen nun einen Blick auf die Top10 Abweichungen (Abweichung_rel) nach oben und nach unten: Für welche Tage liegt der Schätzer auf Basis des Vorwochenwertes besonders weit daneben? Oder gibt es Warengruppen, für die der Schätzer besonders viele große Ausreißer aufweist?

## # A tibble: 10 x 59
## # Groups:   Warengruppe [3]
##    Datum      Warengruppe Umsatz  Jahr KielerWoche Bewoelkung Temperatur
##    <date>           <dbl>  <dbl> <dbl>       <dbl>      <dbl>      <dbl>
##  1 2015-12-31           5  1870.  2015           0          7        2  
##  2 2018-12-31           5  1668.  2018           0          7        7.4
##  3 2016-12-31           5  1705.  2016           0          7        4.9
##  4 2014-12-31           5  1879.  2014           0          6        7.4
##  5 2013-12-31           5  1626.  2013           0          4        5  
##  6 2017-12-31           5  1432.  2017           0          7        8.2
##  7 2016-05-16           4   221.  2016           0          5       11.2
##  8 2017-04-15           1   396.  2017           0          6        8.1
##  9 2018-03-31           1   417.  2018           0          7        2.2
## 10 2019-04-20           1   382.  2019           0          0       13.1
## # ... with 52 more variables: Windgeschwindigkeit <dbl>, Wochentag <dbl>,
## #   Monat <dbl>, Wochentag_c <chr>, Monat_c <chr>, Wochenende <dbl>,
## #   SommerferienSH <dbl>, SommerferienNRW <dbl>, SommerferienNDS <dbl>,
## #   SommerferienHE <dbl>, Feiertag <dbl>, Ostern <dbl>,
## #   ChristiHimmelfahrt <dbl>, Pfingsten <dbl>, TDE <dbl>, Silvester <dbl>,
## #   Ostern_ext <dbl>, ChristiHimmelfahrt_ext <dbl>, Pfingsten_ext <dbl>,
## #   Silvester_ext <dbl>, Jahreszeit <chr>, Fruehling <dbl>, Sommer <dbl>,
## #   Herbst <dbl>, Winter <dbl>, Umsatz_NA <lgl>, Umsatz_lag_1W <dbl>,
## #   Umsatz_lag_2W <dbl>, Umsatz_lag_3W <dbl>, Umsatz_lag_4W <dbl>,
## #   Umsatz_lag <dbl>, Umsatz_gewMW_4W <dbl>, Umsatz_lag_1T <dbl>,
## #   Umsatz_lag_2T <dbl>, Umsatz_lag_3T <dbl>, Umsatz_lag_4T <dbl>,
## #   Umsatz_lag_5T <dbl>, Umsatz_lag_6T <dbl>, Umsatz_lag_7T <dbl>,
## #   Umsatz_lag_8T <dbl>, Umsatz_lag_13T <dbl>, Umsatz_lag_14T <dbl>,
## #   Umsatz_glDS_3T <dbl>, Umsatz_glDS_3T_erw <dbl>, Umsatz_temp <dbl>,
## #   Umsatz_glDS_4T_erw <dbl>, Prognose_zuhoch <lgl>, Abweichung <dbl>,
## #   Abweichung_abs <dbl>, Abweichung_rel <dbl>, Abweichung_quad <dbl>,
## #   Anzahl <int>
## # A tibble: 10 x 59
## # Groups:   Warengruppe [2]
##    Datum      Warengruppe Umsatz  Jahr KielerWoche Bewoelkung Temperatur
##    <date>           <dbl>  <dbl> <dbl>       <dbl>      <dbl>      <dbl>
##  1 2017-04-23           1   54.2  2017           0          4        7.9
##  2 2015-11-22           1   24.8  2015           0          7        2.2
##  3 2017-01-08           5  206.   2017           0          8        2.2
##  4 2014-04-20           1   57.8  2014           0          0       13.9
##  5 2015-04-19           1   25.5  2015           0          0       10.1
##  6 2016-01-04           5  190.   2016           0          5       -6  
##  7 2015-04-12           1   39.0  2015           0          5       12.4
##  8 2018-04-02           1   43.2  2018           0          5        6.1
##  9 2015-10-18           1   23.1  2015           0          8       11.1
## 10 2017-04-17           1   23.2  2017           0          6        6.2
## # ... with 52 more variables: Windgeschwindigkeit <dbl>, Wochentag <dbl>,
## #   Monat <dbl>, Wochentag_c <chr>, Monat_c <chr>, Wochenende <dbl>,
## #   SommerferienSH <dbl>, SommerferienNRW <dbl>, SommerferienNDS <dbl>,
## #   SommerferienHE <dbl>, Feiertag <dbl>, Ostern <dbl>,
## #   ChristiHimmelfahrt <dbl>, Pfingsten <dbl>, TDE <dbl>, Silvester <dbl>,
## #   Ostern_ext <dbl>, ChristiHimmelfahrt_ext <dbl>, Pfingsten_ext <dbl>,
## #   Silvester_ext <dbl>, Jahreszeit <chr>, Fruehling <dbl>, Sommer <dbl>,
## #   Herbst <dbl>, Winter <dbl>, Umsatz_NA <lgl>, Umsatz_lag_1W <dbl>,
## #   Umsatz_lag_2W <dbl>, Umsatz_lag_3W <dbl>, Umsatz_lag_4W <dbl>,
## #   Umsatz_lag <dbl>, Umsatz_gewMW_4W <dbl>, Umsatz_lag_1T <dbl>,
## #   Umsatz_lag_2T <dbl>, Umsatz_lag_3T <dbl>, Umsatz_lag_4T <dbl>,
## #   Umsatz_lag_5T <dbl>, Umsatz_lag_6T <dbl>, Umsatz_lag_7T <dbl>,
## #   Umsatz_lag_8T <dbl>, Umsatz_lag_13T <dbl>, Umsatz_lag_14T <dbl>,
## #   Umsatz_glDS_3T <dbl>, Umsatz_glDS_3T_erw <dbl>, Umsatz_temp <dbl>,
## #   Umsatz_glDS_4T_erw <dbl>, Prognose_zuhoch <lgl>, Abweichung <dbl>,
## #   Abweichung_abs <dbl>, Abweichung_rel <dbl>, Abweichung_quad <dbl>,
## #   Anzahl <int>

Für Silvester liefert unser naiver Schätzer auf Basis des erweiterten gleitenden Durchschnitts der letzten 3 Wochen- bzw. Wochenendtage offenbar systematisch zu niedrige Prognosen, besonders für Warengruppe 5 (Kuchen), was vermutlich am Verkauf der Berliner liegt. Das war zu erwarten, weil Silvester immer sehr umsatzstarke Tage sind. Für die Tage mit deutlich hoher Prognose ist auf den ersten Blick keine Systematik zu erkennen.

Erweiterter gl. Durchschnitt der letzten 4 Wochen- bzw. Wochenendtage

Als Modellerweiterung betrachten wir nun die letzten 4 Wochen- bzw. Wochenendtage und erhoffen uns davon, dass die Schätzung für den Sonntag treffsicherer wird.

Für die Schätzung und die anschließende Ermittlung der Gütemaße verwenden wir einen eigenen Datensatz prog_naiv_glDS_4T_erw. Wir starten wieder am 01.08.2013, um die Vergleichbarkeit der naiven Modelle zu wahren.

## # A tibble: 10 x 4
## # Groups:   Warengruppe [5]
##    Warengruppe Prognose_zuhoch Anteil_abs Anteil_rel
##          <dbl> <lgl>                <int>      <dbl>
##  1           1 FALSE                 1067         50
##  2           1 TRUE                  1078         50
##  3           2 FALSE                 1038         48
##  4           2 TRUE                  1107         52
##  5           3 FALSE                 1025         48
##  6           3 TRUE                  1120         52
##  7           4 FALSE                  980         47
##  8           4 TRUE                  1118         53
##  9           5 FALSE                 1036         48
## 10           5 TRUE                  1109         52
## # A tibble: 5 x 10
##   Warengruppe Anzahl mittlUmsatz mittlAbw StdAbw mittlAbw_abs mittlAbw_rel
##         <dbl>  <int>       <dbl>    <dbl>  <dbl>        <dbl>        <dbl>
## 1           1   2145       125.   -0.831    38.0         28.4           23
## 2           2   2145       399.   -1.58     64.5         46.0           12
## 3           3   2145       166.   -0.451    34.1         24.5           15
## 4           4   2098        87.2   0.0940   28.3         20.5           23
## 5           5   2145       277.   -2.31     93.0         42.2           15
## # ... with 3 more variables: mittlAbw_quad <dbl>, Abweichung_Q5 <dbl>,
## #   Abweichung_Q95 <dbl>

Die Verteilung der relativen Abweichung erscheint ebenfalls schmal. Unser naiver Schätzer auf Basis des erweiterten gleitenden Durchschnitts der letzten 4 Wochentage (für Mo bis Fr) bzw. Wochenendtage (für Sa und So) liefert eine treffendere Umsatzprognose. Augenscheinlich gibt es aber immer noch einige Prognosewerte, die deutlich zu hoch sind. Diese Ausreißer wollen wir nun näher untersuchen, um zu verstehen, an welchen Stellen unser Modell noch Probleme hat. Für die Untersuchung der Prognosegüte hatten wir den Datensatz prog_naiv_glDS_4T_erw erstellt, mit dem wir jetzt weiter arbeiten.

## # A tibble: 4 x 2
##   Warengruppe Anzahl
##         <dbl>  <int>
## 1           1     75
## 2           3      4
## 3           4     32
## 4           5     12
## # A tibble: 3 x 3
## # Groups:   Warengruppe [2]
##   Warengruppe Feiertag Anzahl
##         <dbl>    <dbl>  <int>
## 1           1        0     58
## 2           1        1     17
## 3           4        0     32
## # A tibble: 7 x 2
##   Wochentag_c Anzahl
##   <chr>        <int>
## 1 Dienstag         9
## 2 Donnerstag       6
## 3 Freitag          6
## 4 Mittwoch         7
## 5 Montag          19
## 6 Samstag         17
## 7 Sonntag         59

Das Modell funktioniert liefert etwas bessere Schätzungen für den Sonntag, der aber immer noch ein Problem darstellt.

Wir werfen nun einen Blick auf die Top10 Abweichungen (Abweichung_rel) nach oben und nach unten: Für welche Tage liegt der Schätzer auf Basis des Vorwochenwertes besonders weit daneben? Oder gibt es Warengruppen, für die der Schätzer besonders viele große Ausreißer aufweist?

## # A tibble: 10 x 59
## # Groups:   Warengruppe [3]
##    Datum      Warengruppe Umsatz  Jahr KielerWoche Bewoelkung Temperatur
##    <date>           <dbl>  <dbl> <dbl>       <dbl>      <dbl>      <dbl>
##  1 2015-12-31           5  1870.  2015           0          7        2  
##  2 2016-12-31           5  1705.  2016           0          7        4.9
##  3 2018-12-31           5  1668.  2018           0          7        7.4
##  4 2014-12-31           5  1879.  2014           0          6        7.4
##  5 2017-12-31           5  1432.  2017           0          7        8.2
##  6 2013-12-31           5  1626.  2013           0          4        5  
##  7 2017-05-25           4   179.  2017           0          2       18.9
##  8 2016-12-29           1   282.  2016           0          3        3.8
##  9 2016-05-16           4   221.  2016           0          5       11.2
## 10 2018-03-31           1   417.  2018           0          7        2.2
## # ... with 52 more variables: Windgeschwindigkeit <dbl>, Wochentag <dbl>,
## #   Monat <dbl>, Wochentag_c <chr>, Monat_c <chr>, Wochenende <dbl>,
## #   SommerferienSH <dbl>, SommerferienNRW <dbl>, SommerferienNDS <dbl>,
## #   SommerferienHE <dbl>, Feiertag <dbl>, Ostern <dbl>,
## #   ChristiHimmelfahrt <dbl>, Pfingsten <dbl>, TDE <dbl>, Silvester <dbl>,
## #   Ostern_ext <dbl>, ChristiHimmelfahrt_ext <dbl>, Pfingsten_ext <dbl>,
## #   Silvester_ext <dbl>, Jahreszeit <chr>, Fruehling <dbl>, Sommer <dbl>,
## #   Herbst <dbl>, Winter <dbl>, Umsatz_NA <lgl>, Umsatz_lag_1W <dbl>,
## #   Umsatz_lag_2W <dbl>, Umsatz_lag_3W <dbl>, Umsatz_lag_4W <dbl>,
## #   Umsatz_lag <dbl>, Umsatz_gewMW_4W <dbl>, Umsatz_lag_1T <dbl>,
## #   Umsatz_lag_2T <dbl>, Umsatz_lag_3T <dbl>, Umsatz_lag_4T <dbl>,
## #   Umsatz_lag_5T <dbl>, Umsatz_lag_6T <dbl>, Umsatz_lag_7T <dbl>,
## #   Umsatz_lag_8T <dbl>, Umsatz_lag_13T <dbl>, Umsatz_lag_14T <dbl>,
## #   Umsatz_glDS_3T <dbl>, Umsatz_glDS_3T_erw <dbl>, Umsatz_temp <dbl>,
## #   Umsatz_glDS_4T_erw <dbl>, Prognose_zuhoch <lgl>, Abweichung <dbl>,
## #   Abweichung_abs <dbl>, Abweichung_rel <dbl>, Abweichung_quad <dbl>,
## #   Anzahl <int>
## # A tibble: 10 x 59
## # Groups:   Warengruppe [3]
##    Datum      Warengruppe Umsatz  Jahr KielerWoche Bewoelkung Temperatur
##    <date>           <dbl>  <dbl> <dbl>       <dbl>      <dbl>      <dbl>
##  1 2014-04-20           1   57.8  2014           0          0       13.9
##  2 2014-09-07           1   49.0  2014           0          5       20  
##  3 2014-02-24           4   57.8  2014           0          1        9.4
##  4 2016-01-04           5  190.   2016           0          5       -6  
##  5 2015-11-22           1   24.8  2015           0          7        2.2
##  6 2015-04-12           1   39.0  2015           0          5       12.4
##  7 2015-04-19           1   25.5  2015           0          0       10.1
##  8 2018-04-02           1   43.2  2018           0          5        6.1
##  9 2015-10-18           1   23.1  2015           0          8       11.1
## 10 2017-04-17           1   23.2  2017           0          6        6.2
## # ... with 52 more variables: Windgeschwindigkeit <dbl>, Wochentag <dbl>,
## #   Monat <dbl>, Wochentag_c <chr>, Monat_c <chr>, Wochenende <dbl>,
## #   SommerferienSH <dbl>, SommerferienNRW <dbl>, SommerferienNDS <dbl>,
## #   SommerferienHE <dbl>, Feiertag <dbl>, Ostern <dbl>,
## #   ChristiHimmelfahrt <dbl>, Pfingsten <dbl>, TDE <dbl>, Silvester <dbl>,
## #   Ostern_ext <dbl>, ChristiHimmelfahrt_ext <dbl>, Pfingsten_ext <dbl>,
## #   Silvester_ext <dbl>, Jahreszeit <chr>, Fruehling <dbl>, Sommer <dbl>,
## #   Herbst <dbl>, Winter <dbl>, Umsatz_NA <lgl>, Umsatz_lag_1W <dbl>,
## #   Umsatz_lag_2W <dbl>, Umsatz_lag_3W <dbl>, Umsatz_lag_4W <dbl>,
## #   Umsatz_lag <dbl>, Umsatz_gewMW_4W <dbl>, Umsatz_lag_1T <dbl>,
## #   Umsatz_lag_2T <dbl>, Umsatz_lag_3T <dbl>, Umsatz_lag_4T <dbl>,
## #   Umsatz_lag_5T <dbl>, Umsatz_lag_6T <dbl>, Umsatz_lag_7T <dbl>,
## #   Umsatz_lag_8T <dbl>, Umsatz_lag_13T <dbl>, Umsatz_lag_14T <dbl>,
## #   Umsatz_glDS_3T <dbl>, Umsatz_glDS_3T_erw <dbl>, Umsatz_temp <dbl>,
## #   Umsatz_glDS_4T_erw <dbl>, Prognose_zuhoch <lgl>, Abweichung <dbl>,
## #   Abweichung_abs <dbl>, Abweichung_rel <dbl>, Abweichung_quad <dbl>,
## #   Anzahl <int>

Für Silvester liefert unser naiver Schätzer auf Basis des erweiterten gleitenden Durchschnitts der letzten 4 Wochen- bzw. Wochenendtage offenbar systematisch zu niedrige Prognosen, besonders für Warengruppe 5 (Kuchen), was vermutlich am Verkauf der Berliner liegt. Das war zu erwarten, weil Silvester immer sehr umsatzstarke Tage sind. Für die Tage mit deutlich hoher Prognose ist auf den ersten Blick keine Systematik zu erkennen.

5.5 Prognose der Umsätze anhand des gewichteten Vorwochendurchschnitts

Nun betrachten wir einen gewichteten Mittelwert der Vorwochen (Umsatz_gewMW_4W) als Schätzer. Hierbei gewichten wir den Wert der Vorwoche mit 50%, den Wert zwei Wochen zurück mit 25% und den Wert drei Wochen zurück mit 15% und den Wert vier Wochen zurück mit 10%.

Für die Schätzung und die anschließende Ermittlung der Gütemaße verwenden wir einen eigenen Datensatz prog_naiv_gewMW_4W. Wir starten wieder am 01.08.2013, um die Vergleichbarkeit der naiven Modelle zu wahren.

## # A tibble: 10 x 4
## # Groups:   Warengruppe [5]
##    Warengruppe Prognose_zuhoch Anteil_abs Anteil_rel
##          <dbl> <lgl>                <int>      <dbl>
##  1           1 FALSE                 1033         48
##  2           1 TRUE                  1112         52
##  3           2 FALSE                  985         46
##  4           2 TRUE                  1160         54
##  5           3 FALSE                 1007         47
##  6           3 TRUE                  1138         53
##  7           4 FALSE                  977         47
##  8           4 TRUE                  1121         53
##  9           5 FALSE                 1000         47
## 10           5 TRUE                  1145         53
## # A tibble: 5 x 10
##   Warengruppe Anzahl mittlUmsatz mittlAbw StdAbw mittlAbw_abs mittlAbw_rel
##         <dbl>  <int>       <dbl>    <dbl>  <dbl>        <dbl>        <dbl>
## 1           1   2145       125.   -0.189    35.4         25.4           20
## 2           2   2145       399.    0.435    79.9         58.4           15
## 3           3   2145       166.   -0.120    44.3         32.8           20
## 4           4   2098        87.2   0.0487   28.5         20.3           23
## 5           5   2145       277.    0.395   104.          47.7           17
## # ... with 3 more variables: mittlAbw_quad <dbl>, Abweichung_Q5 <dbl>,
## #   Abweichung_Q95 <dbl>

Die Verteilung der relativen Abweichung erscheint zwar breit. Aber es scheint weniger Ausreißer nach oben zu geben, als in den anderen naiven Modellen. Unser naiver Schätzer auf Basis des gewichteten Vorwochendurchschnitts liefert insgesamt keine gute Umsatzprognose. Augenscheinlich gibt es einige Prognosewerte, die deutlich zu hoch sind. Diese Ausreißer wollen wir nun näher untersuchen, um zu verstehen, an welchen Stellen unser Modell noch Probleme hat. Für die Untersuchung der Prognosegüte hatten wir den Datensatz prog_naiv_gewMW_4W erstellt, mit dem wir jetzt weiter arbeiten.

## # A tibble: 5 x 2
##   Warengruppe Anzahl
##         <dbl>  <int>
## 1           1     33
## 2           2      2
## 3           3      4
## 4           4     38
## 5           5     14
## # A tibble: 3 x 3
## # Groups:   Warengruppe [2]
##   Warengruppe Feiertag Anzahl
##         <dbl>    <dbl>  <int>
## 1           1        0     23
## 2           1        1     10
## 3           4        0     38
## # A tibble: 7 x 2
##   Wochentag_c Anzahl
##   <chr>        <int>
## 1 Dienstag         8
## 2 Donnerstag      15
## 3 Freitag          6
## 4 Mittwoch        15
## 5 Montag          14
## 6 Samstag         17
## 7 Sonntag         16

Die Schätzung auf Basis des gewichteten Durchschnitts der letzten 4 Wochen liefert offenbar für alle Wochentage wenig Ausreißer nach oben.

Wir werfen nun einen Blick auf die Top10 Abweichungen (Abweichung_rel) nach oben und nach unten: Für welche Tage liegt der Schätzer auf Basis des Vorwochenwertes besonders weit daneben? Oder gibt es Warengruppen, für die der Schätzer besonders viele große Ausreißer aufweist?

## # A tibble: 10 x 59
## # Groups:   Warengruppe [2]
##    Datum      Warengruppe Umsatz  Jahr KielerWoche Bewoelkung Temperatur
##    <date>           <dbl>  <dbl> <dbl>       <dbl>      <dbl>      <dbl>
##  1 2015-12-31           5  1870.  2015           0          7        2  
##  2 2013-12-31           5  1626.  2013           0          4        5  
##  3 2016-12-31           5  1705.  2016           0          7        4.9
##  4 2014-12-31           5  1879.  2014           0          6        7.4
##  5 2018-12-31           5  1668.  2018           0          7        7.4
##  6 2017-12-31           5  1432.  2017           0          7        8.2
##  7 2016-02-04           4   213.  2016           0          5        4.2
##  8 2016-05-16           4   221.  2016           0          5       11.2
##  9 2015-02-06           4   220.  2015           0          2       -0.5
## 10 2016-02-06           4   192.  2016           0          7        9.4
## # ... with 52 more variables: Windgeschwindigkeit <dbl>, Wochentag <dbl>,
## #   Monat <dbl>, Wochentag_c <chr>, Monat_c <chr>, Wochenende <dbl>,
## #   SommerferienSH <dbl>, SommerferienNRW <dbl>, SommerferienNDS <dbl>,
## #   SommerferienHE <dbl>, Feiertag <dbl>, Ostern <dbl>,
## #   ChristiHimmelfahrt <dbl>, Pfingsten <dbl>, TDE <dbl>, Silvester <dbl>,
## #   Ostern_ext <dbl>, ChristiHimmelfahrt_ext <dbl>, Pfingsten_ext <dbl>,
## #   Silvester_ext <dbl>, Jahreszeit <chr>, Fruehling <dbl>, Sommer <dbl>,
## #   Herbst <dbl>, Winter <dbl>, Umsatz_NA <lgl>, Umsatz_lag_1W <dbl>,
## #   Umsatz_lag_2W <dbl>, Umsatz_lag_3W <dbl>, Umsatz_lag_4W <dbl>,
## #   Umsatz_lag <dbl>, Umsatz_gewMW_4W <dbl>, Umsatz_lag_1T <dbl>,
## #   Umsatz_lag_2T <dbl>, Umsatz_lag_3T <dbl>, Umsatz_lag_4T <dbl>,
## #   Umsatz_lag_5T <dbl>, Umsatz_lag_6T <dbl>, Umsatz_lag_7T <dbl>,
## #   Umsatz_lag_8T <dbl>, Umsatz_lag_13T <dbl>, Umsatz_lag_14T <dbl>,
## #   Umsatz_glDS_3T <dbl>, Umsatz_glDS_3T_erw <dbl>, Umsatz_temp <dbl>,
## #   Umsatz_glDS_4T_erw <dbl>, Prognose_zuhoch <lgl>, Abweichung <dbl>,
## #   Abweichung_abs <dbl>, Abweichung_rel <dbl>, Abweichung_quad <dbl>,
## #   Anzahl <int>
## # A tibble: 10 x 59
## # Groups:   Warengruppe [3]
##    Datum      Warengruppe Umsatz  Jahr KielerWoche Bewoelkung Temperatur
##    <date>           <dbl>  <dbl> <dbl>       <dbl>      <dbl>      <dbl>
##  1 2015-10-18           1   23.1  2015           0          8       11.1
##  2 2014-03-02           4  108.   2014           0          6        6.6
##  3 2018-04-02           1   43.2  2018           0          5        6.1
##  4 2017-04-22           1   81.4  2017           0          5        7.5
##  5 2017-01-07           5  266.   2017           0          8       -0.5
##  6 2019-01-07           5  250.   2019           0          8        5.9
##  7 2015-01-07           5  263.   2015           0          6        5.8
##  8 2014-01-07           5  211.   2014           0          7       10.4
##  9 2016-01-07           5  212.   2016           0          7       -4  
## 10 2017-04-17           1   23.2  2017           0          6        6.2
## # ... with 52 more variables: Windgeschwindigkeit <dbl>, Wochentag <dbl>,
## #   Monat <dbl>, Wochentag_c <chr>, Monat_c <chr>, Wochenende <dbl>,
## #   SommerferienSH <dbl>, SommerferienNRW <dbl>, SommerferienNDS <dbl>,
## #   SommerferienHE <dbl>, Feiertag <dbl>, Ostern <dbl>,
## #   ChristiHimmelfahrt <dbl>, Pfingsten <dbl>, TDE <dbl>, Silvester <dbl>,
## #   Ostern_ext <dbl>, ChristiHimmelfahrt_ext <dbl>, Pfingsten_ext <dbl>,
## #   Silvester_ext <dbl>, Jahreszeit <chr>, Fruehling <dbl>, Sommer <dbl>,
## #   Herbst <dbl>, Winter <dbl>, Umsatz_NA <lgl>, Umsatz_lag_1W <dbl>,
## #   Umsatz_lag_2W <dbl>, Umsatz_lag_3W <dbl>, Umsatz_lag_4W <dbl>,
## #   Umsatz_lag <dbl>, Umsatz_gewMW_4W <dbl>, Umsatz_lag_1T <dbl>,
## #   Umsatz_lag_2T <dbl>, Umsatz_lag_3T <dbl>, Umsatz_lag_4T <dbl>,
## #   Umsatz_lag_5T <dbl>, Umsatz_lag_6T <dbl>, Umsatz_lag_7T <dbl>,
## #   Umsatz_lag_8T <dbl>, Umsatz_lag_13T <dbl>, Umsatz_lag_14T <dbl>,
## #   Umsatz_glDS_3T <dbl>, Umsatz_glDS_3T_erw <dbl>, Umsatz_temp <dbl>,
## #   Umsatz_glDS_4T_erw <dbl>, Prognose_zuhoch <lgl>, Abweichung <dbl>,
## #   Abweichung_abs <dbl>, Abweichung_rel <dbl>, Abweichung_quad <dbl>,
## #   Anzahl <int>

Für Silvester liefert unser naiver Schätzer auf Basis des erweiterten gleitenden Durchschnitts der letzten 4 Wochen- bzw. Wochenendtage offenbar systematisch zu niedrige Prognosen, besonders für Warengruppe 5 (Kuchen), was vermutlich am Verkauf der Berliner liegt. Das war zu erwarten, weil Silvester immer sehr umsatzstarke Tage sind. Ebenso liefert das Modell für den 7. Januar konsequent zu hohe Schätzwerte, weil diese - zumindest zu einem großen Teil (50%) - auf Basis der sehr hohen Silvester-Umsätze prognostiziert werden.

5.6 Vergleich der naiven Modelle

Wir wollen jetzt die Ergebnisse der verschiedenen naiven Modelle vergleichen. Und zwar beschränken wir uns auf das Jahr 2018, weil wir die späteren Modelle (lineare Regression, Support Vector Machines, Multilayer-Perceptron,…) ebenfalls für das Jahr 2018 testen werden und einen Vergleich zu den naiven Modellen herstellen wollen.

Wir haben in diesem Kapitel die folgenden Analysedatensätze verwendet und gefüllt:

  • prog_naiv_lag_1W
  • prog_naiv_glDS_3T
  • prog_naiv_glDS_3T_erw
  • prog_naiv_glDS_4T_erw
  • prog_naiv_gewMW_4W

Vergleich der relativen Abweichung

Nun bringen wir die relativen Abweichungen in einem Datensatz zusammen, je Datum, Warengruppe und Modell, um damit Facetten-Plots der Dichteverteilung und Boxplots der Verteilungen zu erstellen.

Als Grundgerüst (Datum, Warengruppe, Jahr, Wochentag) für die gemeinsame Tabelle dient uns der ursprüngliche Datensatz df_naiv. Wir starten ab dem 01.08.2013, weil wir ab diesem Datum Schätzer für alle Modelle haben. Und wir streichen die Datensätze, für die die Umsätze in den Rohdaten fehlen.

Füge als nächstes die relativen Abweichungen an die Tabelle an:

Wir müssen die Tabelle noch pivotisieren (pivot_longer), als Vorbereitung für den anschließenden Plot:

Stelle nun die Verteilung der relativen Abweichung für die verschiedenen naiven Modelle in einem Plot dar, examplarisch für die Warengruppe 1:

## Warning: Removed 13 rows containing non-finite values (stat_density).

Man könnte hier noch die Verteilungen für die übrigen Warengruppen darstellen, der Erkenntnisgewinn ist jedoch vermutlich gering, daher verzichten wir darauf.

Stattdessen stellen wir die Verteilungen im Vergleich exemplarisch für Montag dar:

## Warning: Removed 5 rows containing non-finite values (stat_density).

Um die Dichteverteilungen besser vergleichen zu können, wählen wir Boxplots und können dann auch die Verteilungen für alle Warengruppen und Wochentage in einem Facetten-Plot zeigen.

## Warning: Removed 14 rows containing non-finite values (stat_boxplot).

## Warning: Removed 14 rows containing non-finite values (stat_boxplot).

## Warning: Removed 14 rows containing non-finite values (stat_boxplot).

## Warning: Removed 7 rows containing non-finite values (stat_boxplot).

Vergleicht man die Dichteverteilungen für das Jahr 2018 insgesamt (über alle Warengruppen und Wochentage), liefert der erweiterte gleitende Durchschnitt der letzten 4 Wochen- bzw. Wochenendtage die besten Ergebnisse.

Unterteilt man die Verteilungen nach Wochentag oder Warengruppe, ergibt sich ein differenzierteres Bild:

Nach Wochentag liefert der erweiterte gleitende Durchschnitt der letzten 3 Wochen- bzw. Wochenendtage die besten Ergebnisse unter der Woche (Mo bis Fr), versagt aber an Wochenenden (Sa und So), wie wir bereits gesehen hatten. Für Samstage liefert der erweiterte gleitende Durchschnitt der letzten 4 anstatt 3 Wochen- bzw. Wochenendtage die besten Ergebnisse. Für Sonntage liefert das einfachste Modell auf Basis des Vorwochenwertes offenbar die treffendsten Schätzer.

Nach Warengruppe liefert der gleitende Durchschnitt der letzten 3 Tage die besten Ergebnisse für Warengruppe 1 (Brot). Die übrigen Warengruppen werden durch den erweiterten gleitenden Durchschnitt der letzten 3 Wochen- bzw. Wochenendtagen am besten prognostiziert.

Guckt man sich die Verteilungen nach Warengruppe OHNE Sommerferien und OHNE Feiertage an, erhält man fast identische Ergebnisse.

Vergleich der Gütekennzahlen

Wir wollen nun die ermittelten Gütekennzahlen für die verschiedenen naiven Modelle verfeinern und zusammen bringen. Dafür erstellen wir eine Vergleichstabelle (prog_naiv_vgl_kennz), die die Kennzahlen je Modell für 2018 enthält. Im ersten Schritt betrachten wir nur die Gesamtgüte für die 5 Modelle und trennen erst später nach Warengruppen und Wochentagen.

Wir möchten nun folgende Gütekennzahlen für die Umsatzschätzung vergleichen:

  • mittlere absolute Abweichung (MAE)
  • mittlere relative Abweichung (MPE)
  • mittlere Absolutwert der relativen Abweichung (MAPE)
  • gewichtetes Mittel des Absolutwerts der relativen Abweichung (WAPE)
  • mittlere quadratische Abweichung (MSE)
  • Wurzel der mittleren quadratischen Abweichung (RMSE)
  • Wurzel der mittleren quadratischen Abweichung relativ zum mittleren Umsatz (rRMSE)

Die mittlere absulute Abweichung (MAE = mean absolute error) gibt uns ein Gefühl, wie start der Schätzer vom tatsächlichen Umsatz abweicht.

Die mittlere relative Abweichung (MPE = mean percentage error) gibt uns Anhaltspunkte, ob und wir stark die Prognose eines Modells systematisch daneben liegt - in Prozent.

Der mittlere Absolutwert der relativen Abweichung (MAPE = mean absolute percentage error) verrät uns, wie stark die Schätzung im Mittel vom tatsächlichen Umsatz abweicht - in beide Richtungen - in Prozent.

Das gewichtete Mittel des Absolutwerts der relativen Abweichung (WAPE = weighted absolute percentage error) bezieht den Umsatz des Schätzers zusätzlich als Gewicht mit ein. Das Ergebnis ist ebenfalls ein Prozentwert.

Die mittlere quadratische Abweichung (MSE = mean squared error) bestraft größere Abweichungen stärker als die übrigen Kennzahlen.

Üblicherweise vergleicht man jedoch die Wurzel der mittleren quadratischen Abweichung (RMSE = root mean squared error). Und wir wollen diese Größe noch ins Verhältnis zum mittleren Umsatz setzen und erhalten eine neue Kennzahl (rRMSE), die uns einen Anhaltspunkt über vorliegende starke Abweichungen der Schätzwerte vom tatsächlichen Umsatz gibt.

Wir haben in diesem Kapitel bisher die folgenden Analysedatensätze verwendet und gefüllt:

  • prog_naiv_lag_1W
  • prog_naiv_glDS_3T
  • prog_naiv_glDS_3T_erw
  • prog_naiv_glDS_4T_erw
  • prog_naiv_gewMW_4W

Diese enthalten schon:

  • Abweichung: Differenz zwischen prognostiziertem und tatsächlichem Umsatz
  • Abweichung_abs: Der Absolutwert der Abweichung
  • Abweichung_rel: Die relative Abweichung

Wir benötigen noch weitere Hilfsgrößen:

  • Abweichung_rel_abs: Der Absolutwert der relativen Abweichung
  • Abweichung_rel_abs_mult_Umsatz: Das ganze noch multipliziert mit dem tatsächlichen Umsatz
# starte mit lag_1W: Ergänze die benötigten Hilfsgrößen
prog_naiv_lag_1W <-  prog_naiv_lag_1W %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- prog_naiv_lag_1W %>%
  group_by() %>%
  filter(Jahr==2018) %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "lag_1W")

# füge die Kennzahlen nun an die Vergleichstabelle
prog_naiv_vgl_kennz <- temp

# weiter mit glDS_3T: Ergänze die benötigten Hilfsgrößen
prog_naiv_glDS_3T <-  prog_naiv_glDS_3T %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- prog_naiv_glDS_3T %>%
  group_by() %>%
  filter(Jahr==2018) %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "glDS_3T")

# füge die Kennzahlen nun an die Vergleichstabelle
prog_naiv_vgl_kennz <- rbind(prog_naiv_vgl_kennz, temp)

# weiter mit glDS_3T_erw: Ergänze die benötigten Hilfsgrößen
prog_naiv_glDS_3T_erw <-  prog_naiv_glDS_3T_erw %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- prog_naiv_glDS_3T_erw %>%
  group_by() %>%
  filter(Jahr==2018) %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "glDS_3T_erw")

# füge die Kennzahlen nun an die Vergleichstabelle
prog_naiv_vgl_kennz <- rbind(prog_naiv_vgl_kennz, temp)

# weiter mit glDS_4T_erw: Ergänze die benötigten Hilfsgrößen
prog_naiv_glDS_4T_erw <-  prog_naiv_glDS_4T_erw %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- prog_naiv_glDS_4T_erw %>%
  group_by() %>%
  filter(Jahr==2018) %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "glDS_4T_erw")

# füge die Kennzahlen nun an die Vergleichstabelle
prog_naiv_vgl_kennz <- rbind(prog_naiv_vgl_kennz, temp)

# weiter mit gewMW_4W: Ergänze die benötigten Hilfsgrößen
prog_naiv_gewMW_4W <-  prog_naiv_gewMW_4W %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- prog_naiv_gewMW_4W %>%
  group_by() %>%
  filter(Jahr==2018) %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "gewMW_4W")

# füge die Kennzahlen nun an die Vergleichstabelle
prog_naiv_vgl_kennz <- rbind(prog_naiv_vgl_kennz, temp)

head(prog_naiv_vgl_kennz)
## # A tibble: 5 x 11
##   Anzahl Umsatz_ges Umsatz_mittel   MAE   MPE  MAPE  WAPE   MSE  RMSE rRMSE
##    <int>      <dbl>         <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1   1789     372262           208    39     4    21    19  4660    68    33
## 2   1789     372262           208    44     6    24    21  4590    68    33
## 3   1789     372262           208    33     4    19    16  3436    59    28
## 4   1789     372262           208    31     4    18    15  3017    55    26
## 5   1789     372262           208    36     4    19    17  3793    62    30
## # ... with 1 more variable: Modell <chr>

Im Vergleich der Gütekennzahlen fällt auf, dass alle Modelle den Umsatz im Schnitt zu hoch schätzen und zwar um 4 bis 6% (MPE). Der erweiterte gleitende Durchschnitt der letzten 4 Wochen- bzw. Wochenendtage (glDS_4T_erw) schneidet am besten ab - zumindest in der Gesamtsicht: WAPE und rRMSE zeigen die niedrigsten Werte. Wir wollen nun die Kennzahlen für dieses Modell je warengruppe und Wochentag betrachten.

## # A tibble: 5 x 11
##   Warengruppe Anzahl Umsatz_ges Umsatz_mittel   MAE   MPE  MAPE  WAPE   MSE
##         <dbl>  <int>      <dbl>         <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1           1    358      47292           132    30     9    26    23  1723
## 2           2    358     135858           379    41     1    11    11  3235
## 3           3    358      61867           173    26     3    16    15  1242
## 4           4    357      29606            83    17     5    21    20   459
## 5           5    358      97639           273    43     2    15    16  8418
## # ... with 2 more variables: RMSE <dbl>, rRMSE <dbl>

Wenn wir uns das Modell (glDS_4T_erw) genauer angucken, sehen wir, dass die Schätzung für die Warengruppe 2 (Brötchen) am besten funktioniert. Der Mittelwert der relativen Abweichung (MPE) liegt nahe Null. Das gewichtete Mittel des Absolutwerts der relativen Abweichung (WAPE) zeigt mit 11 den niedrigsten Wert. Auch der Wert für rRMSE ist deutlich niedriger als für die übrigen Warengruppen, es liegen also weniger starke Abweichungen der Schätzwerte vom tatsächlichen Umsatz vor.

Auch für Warengruppe 5 (Kuchen) liefert das Modell offenbar gute Schätzungen. Auffällig ist jedoch, dass die mittlere quadratische Abweichung (MSE) deutlich höher ist, als für die anderen Warengruppen. Das liegt am Schätzfehler für Silvester: Wie wir bereits gesehen hatten, haben wir in der Warengruppe auffällig hohen Umsatz durch den Berlinerverkauf.

Zuletzt gucken wir uns die Gütekennzahlen für dieses Modell je Wochentag an.

## # A tibble: 7 x 11
##   Wochentag_c Anzahl Umsatz_ges Umsatz_mittel   MAE   MPE  MAPE  WAPE   MSE
##   <chr>        <int>      <dbl>         <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Dienstag       250      47068           188    25     5    16    13  1174
## 2 Donnerstag     260      51426           198    26    -3    15    13  1410
## 3 Freitag        255      50703           199    22    -3    13    11   925
## 4 Mittwoch       250      46145           185    22     8    16    12   815
## 5 Montag         254      50733           200    42    10    22    21 10013
## 6 Samstag        260      63057           243    39     1    18    16  3679
## 7 Sonntag        260      63130           243    42    10    26    17  3068
## # ... with 2 more variables: RMSE <dbl>, rRMSE <dbl>

Offenbar versagt dieses Modell für Montage und Sonntage: Allein die mittlere relative Abweichung (MPE) liegt für diese beiden Tage bei 10%.

Top10 Tage der größten Abweichungen

Wir untersuchen nun die Tage mit den größten Abweichungen nach oben und unten für die verschiedenen naiven Modelle. Dabei beschränken wir uns auf das Jahr 2018, weil dieser Zeitraum auch für die anderen Modelle als Testzeitraum feststeht und wir dann die Modelle besser vergleichen können. Wir erstellen eine gemeinsame Tabelle für alle Modelle (prog_naiv_vgl_top).

Wir wollen rausfinden, ob es Tage gibt, die in allen Modellen schlecht prognostiziert werden. Für die zu niedrigen Prognosen war das vor allem der Silvester in WG5 (Kuchen = Berliner). Aber was ist mit den Tagen, an denen die Prognose zu hoch war? Den 7. Januar haben wir für einige Modelle schon erklärt. Gibt es weitere auffällige Tage? Oder führen bspw. die Sommerferien systematisch zu größeren Abweichungen?

# starte mit lag_1W: Größte rel. Abweichungen, bei denen der Umsatz zu hoch geschätzt wurde
temp <- prog_naiv_lag_1W %>%
  filter(Jahr==2018) %>%
  arrange(Abweichung_rel) %>%
  head(n=10)

# füge das Modell und die Kategorie hinzu
temp <- temp %>% 
  mutate(Modell = "lag_1W") %>%
  mutate(Prognose = "zu tief")

# füge die Kennzahlen nun an die Vergleichstabelle
prog_naiv_vgl_top <- temp

# Größte rel. Abweichungen, bei denen der Umsatz zu niedrig geschätzt wurde
temp <- prog_naiv_lag_1W %>%
  filter(Jahr==2018) %>%
  arrange(Abweichung_rel) %>%
  tail(n=10)

# füge das Modell und die Kategorie hinzu
temp <- temp %>% 
  mutate(Modell = "lag_1W") %>%
  mutate(Prognose = "zu hoch")

# füge die Kennzahlen nun an die Vergleichstabelle
prog_naiv_vgl_top <- rbind(prog_naiv_vgl_top, temp)

# weiter mit glDS_3T: Größte rel. Abweichungen, bei denen der Umsatz zu hoch geschätzt wurde
temp <- prog_naiv_glDS_3T %>%
  filter(Jahr==2018) %>%
  arrange(Abweichung_rel) %>%
  head(n=10)

# füge das Modell und die Kategorie hinzu
temp <- temp %>% 
  mutate(Modell = "glDS_3T") %>%
  mutate(Prognose = "zu tief")

# füge die Kennzahlen nun an die Vergleichstabelle
prog_naiv_vgl_top <- rbind(prog_naiv_vgl_top, temp)

# Größte rel. Abweichungen, bei denen der Umsatz zu niedrig geschätzt wurde
temp <- prog_naiv_glDS_3T %>%
  filter(Jahr==2018) %>%
  arrange(Abweichung_rel) %>%
  tail(n=10)

# füge das Modell und die Kategorie hinzu
temp <- temp %>% 
  mutate(Modell = "glDS_3T") %>%
  mutate(Prognose = "zu hoch")

# füge die Kennzahlen nun an die Vergleichstabelle
prog_naiv_vgl_top <- rbind(prog_naiv_vgl_top, temp)

# weiter mit glDS_3T_erw: Größte rel. Abw., bei denen der Umsatz zu hoch geschätzt wurde
temp <- prog_naiv_glDS_3T_erw %>%
  filter(Jahr==2018) %>%
  arrange(Abweichung_rel) %>%
  head(n=10)

# füge das Modell und die Kategorie hinzu
temp <- temp %>% 
  mutate(Modell = "glDS_3T_erw") %>%
  mutate(Prognose = "zu tief")

# füge die Kennzahlen nun an die Vergleichstabelle
prog_naiv_vgl_top <- rbind(prog_naiv_vgl_top, temp)

# Größte rel. Abweichungen, bei denen der Umsatz zu niedrig geschätzt wurde
temp <- prog_naiv_glDS_3T_erw %>%
  filter(Jahr==2018) %>%
  arrange(Abweichung_rel) %>%
  tail(n=10)

# füge das Modell und die Kategorie hinzu
temp <- temp %>% 
  mutate(Modell = "glDS_3T_erw") %>%
  mutate(Prognose = "zu hoch")

# füge die Kennzahlen nun an die Vergleichstabelle
prog_naiv_vgl_top <- rbind(prog_naiv_vgl_top, temp)

# weiter mit glDS_4T_erw: Größte rel. Abw., bei denen der Umsatz zu hoch geschätzt wurde
temp <- prog_naiv_glDS_4T_erw %>%
  filter(Jahr==2018) %>%
  arrange(Abweichung_rel) %>%
  head(n=10)

# füge das Modell und die Kategorie hinzu
temp <- temp %>% 
  mutate(Modell = "glDS_4T_erw") %>%
  mutate(Prognose = "zu tief")

# füge die Kennzahlen nun an die Vergleichstabelle
prog_naiv_vgl_top <- rbind(prog_naiv_vgl_top, temp)

# Größte rel. Abweichungen, bei denen der Umsatz zu niedrig geschätzt wurde
temp <- prog_naiv_glDS_4T_erw %>%
  filter(Jahr==2018) %>%
  arrange(Abweichung_rel) %>%
  tail(n=10)

# füge das Modell und die Kategorie hinzu
temp <- temp %>% 
  mutate(Modell = "glDS_4T_erw") %>%
  mutate(Prognose = "zu hoch")

# füge die Kennzahlen nun an die Vergleichstabelle
prog_naiv_vgl_top <- rbind(prog_naiv_vgl_top, temp)

# weiter mit gewMW_4W: Größte rel. Abw., bei denen der Umsatz zu hoch geschätzt wurde
temp <- prog_naiv_gewMW_4W %>%
  filter(Jahr==2018) %>%
  arrange(Abweichung_rel) %>%
  head(n=10)

# füge das Modell und die Kategorie hinzu
temp <- temp %>% 
  mutate(Modell = "gewMW_4W") %>%
  mutate(Prognose = "zu tief")

# füge die Kennzahlen nun an die Vergleichstabelle
prog_naiv_vgl_top <- rbind(prog_naiv_vgl_top, temp)

# Größte rel. Abweichungen, bei denen der Umsatz zu niedrig geschätzt wurde
temp <- prog_naiv_gewMW_4W %>%
  filter(Jahr==2018) %>%
  arrange(Abweichung_rel) %>%
  tail(n=10)

# füge das Modell und die Kategorie hinzu
temp <- temp %>% 
  mutate(Modell = "gewMW_4W") %>%
  mutate(Prognose = "zu hoch")

# füge die Kennzahlen nun an die Vergleichstabelle
prog_naiv_vgl_top <- rbind(prog_naiv_vgl_top, temp)

Nun wollen wir im Detail analysieren, für welche Tage der Umsatz systematisch zu hoch oder zu tief geschätzt wird durch unsere verschiedenen naiven Modelle.

## # A tibble: 45 x 3
## # Groups:   Datum [44]
##    Datum      Prognose Anzahl
##    <date>     <chr>     <int>
##  1 2018-03-29 zu tief      10
##  2 2018-12-31 zu tief       8
##  3 2018-03-31 zu tief       5
##  4 2018-04-02 zu hoch       5
##  5 2018-06-23 zu tief       4
##  6 2018-11-10 zu hoch       4
##  7 2018-01-06 zu hoch       3
##  8 2018-02-18 zu hoch       3
##  9 2018-03-18 zu tief       3
## 10 2018-04-01 zu hoch       3
## # ... with 35 more rows

Die erste Beobachtung ist, dass einige Daten mehrfach auftauchen. Auffällig ist - wie schon bekannt - Silvester: Dieser Tag ist in jedem Jahr sehr umsatzstark und wird von den naiven Modellen auf Basis der jüngeren Vergangenheit nicht gut vorhergesagt. Und dann fällt noch der 29.03.2018 auf.

Um insgesamt besser zu verstehen, was die stark zu hohen oder zu niedrigen Schätzwerte verursacht, nehmen wir weitere Einflussfaktoren für die gefundenen Daten hinzu:

## # A tibble: 53 x 4
## # Groups:   Datum, Warengruppe [53]
##    Datum      Warengruppe Prognose Anzahl
##    <date>           <dbl> <chr>     <int>
##  1 2018-03-29           1 zu tief       5
##  2 2018-03-29           3 zu tief       5
##  3 2018-04-02           1 zu hoch       5
##  4 2018-12-31           5 zu tief       5
##  5 2018-03-31           1 zu tief       4
##  6 2018-06-23           5 zu tief       4
##  7 2018-11-10           4 zu hoch       4
##  8 2018-02-18           1 zu hoch       3
##  9 2018-04-01           1 zu hoch       3
## 10 2018-05-24           4 zu hoch       3
## # ... with 43 more rows

Jetzt sehen wir u.a., dass für den 29.03.2018 die Umsätze in den Warengruppen 1 und 3 für alle 5 naiven Modellen zu tief geschätzt wird. Und Silvester wird die Warengruppe 5 (Kuchen = Berliner) ebenfalls in allen Modelle zu tief geschätzt.

Für fast alle Daten ist die Prognose entweder konsequent zu hoch oder konsequent zu tief. Das Datum 07.01.2018 ist das einzige Datum, für das je zwei Schätzungen stark zu hoch (Warengruppe 5) bzw. stark zu niedrieg (Warengruppe 4) waren. Es handelt sich um den Tag eine Woche nach Silvester, der in den Modellen auf Basis des Vorwochendurchschnitts (lag_1W) und des gewichteten Vorwochendurchschnitts (gewDS_4W) schlecht geschätzt wird, weil die Schätzgrundlage (Silvester) verzerrt ist.

Wir prüfen nun, ob allgemein Ferien oder Feiertage für die Tage mit starken Abweichungen zwischen Schätzer und tatsächlichem Umsatz eine Rolle spielen.

## # A tibble: 3 x 3
## # Groups:   Prognose [2]
##   Prognose SommerferienSH Anzahl
##   <chr>             <dbl>  <int>
## 1 zu hoch               0     50
## 2 zu tief               0     47
## 3 zu tief               1      3
## # A tibble: 4 x 3
## # Groups:   Prognose [2]
##   Prognose Feiertag Anzahl
##   <chr>       <dbl>  <int>
## 1 zu tief         0     42
## 2 zu hoch         0     39
## 3 zu hoch         1     11
## 4 zu tief         1      8

Die Sommerferien in Schleswig-Holstein haben offenbar nichts mit der schlechten Schätzung zu tun. Die Feiertage hingegen schon, aber das hatten wir erwartet: Besonders Silvester hat hier einen nennenswerten Einfluss.

Als letztes gucken wir uns den Einzeltag 29.03.2018 genau an, für den die Umsätze in den Warengruppen 1 und 3 für alle 5 naiven Modellen zu tief geschätzt wird.

## # A tibble: 10 x 63
## # Groups:   Warengruppe [2]
##    Datum      Warengruppe Umsatz  Jahr KielerWoche Bewoelkung Temperatur
##    <date>           <dbl>  <dbl> <dbl>       <dbl>      <dbl>      <dbl>
##  1 2018-03-29           3   266.  2018           0          7        0.9
##  2 2018-03-29           1   370.  2018           0          7        0.9
##  3 2018-03-29           1   370.  2018           0          7        0.9
##  4 2018-03-29           3   266.  2018           0          7        0.9
##  5 2018-03-29           1   370.  2018           0          7        0.9
##  6 2018-03-29           3   266.  2018           0          7        0.9
##  7 2018-03-29           1   370.  2018           0          7        0.9
##  8 2018-03-29           3   266.  2018           0          7        0.9
##  9 2018-03-29           3   266.  2018           0          7        0.9
## 10 2018-03-29           1   370.  2018           0          7        0.9
## # ... with 56 more variables: Windgeschwindigkeit <dbl>, Wochentag <dbl>,
## #   Monat <dbl>, Wochentag_c <chr>, Monat_c <chr>, Wochenende <dbl>,
## #   SommerferienSH <dbl>, SommerferienNRW <dbl>, SommerferienNDS <dbl>,
## #   SommerferienHE <dbl>, Feiertag <dbl>, Ostern <dbl>,
## #   ChristiHimmelfahrt <dbl>, Pfingsten <dbl>, TDE <dbl>, Silvester <dbl>,
## #   Ostern_ext <dbl>, ChristiHimmelfahrt_ext <dbl>, Pfingsten_ext <dbl>,
## #   Silvester_ext <dbl>, Jahreszeit <chr>, Fruehling <dbl>, Sommer <dbl>,
## #   Herbst <dbl>, Winter <dbl>, Umsatz_NA <lgl>, Umsatz_lag_1W <dbl>,
## #   Umsatz_lag_2W <dbl>, Umsatz_lag_3W <dbl>, Umsatz_lag_4W <dbl>,
## #   Umsatz_lag <dbl>, Umsatz_gewMW_4W <dbl>, Umsatz_lag_1T <dbl>,
## #   Umsatz_lag_2T <dbl>, Umsatz_lag_3T <dbl>, Umsatz_lag_4T <dbl>,
## #   Umsatz_lag_5T <dbl>, Umsatz_lag_6T <dbl>, Umsatz_lag_7T <dbl>,
## #   Umsatz_lag_8T <dbl>, Umsatz_lag_13T <dbl>, Umsatz_lag_14T <dbl>,
## #   Umsatz_glDS_3T <dbl>, Umsatz_glDS_3T_erw <dbl>, Umsatz_temp <dbl>,
## #   Umsatz_glDS_4T_erw <dbl>, Prognose_zuhoch <lgl>, Abweichung <dbl>,
## #   Abweichung_abs <dbl>, Abweichung_rel <dbl>, Abweichung_quad <dbl>,
## #   Anzahl <int>, Abweichung_rel_abs <dbl>,
## #   Abweichung_rel_abs_mult_umsatz <dbl>, Modell <chr>, Prognose <chr>

Und auch hier ist die Erklärung für den zu niedrig geschätzten Umsatz ein Feiertagseffekt: Beim 29.03.2018 handelt es sich um den Donnerstag vor Karfreitag.

Fazit naive Modelle

Wir stellen also insgesamt fest, dass unsere naiven Modelle die Umsätze auf Basis der jüngeren Vergangenheit schätzen. Stärkere Umsätze an oder vor Feiertagen werden nicht vorhergesagt und die Umsätze nach Feiertagen werden entsprechend zu hoch geschätzt.

Eine Verbesserung der naiven Modelle könnten wir erzielen, indem wir die Umsätze für Feiertage auf Basis der Vorjahreswerte schätzen. Das funktioniert naiv aber nur für Feiertage, die an festen Daten liegen, wie bspw. Silvester. Für Ostern funktioniert dieses naive Vorgehen nicht. Wir verzichten auf diese Modellerweiterung und widmen uns stattdessen im Folgenden statistischen Modellen und betrachten Machine Learning und Deep Learning Modelle.

6 Anwendung statistischer Modelle - Lineare Regression

6.1 Vorhaben

In einem nächsten Schritt wird mit der linearen Regression ein traditionelles statistisches Modell zur Prognose der Bäckereiumsätze eingesetzt. Die lineare Regression ist ein sehr einfacher Ansatz für das sog. “überwachte Lernen” (supervised learning). Lineare Regressionsmodelle sind insbesondere ein nützliches Werkzeug zur Vorhersage einer quantitativen Output-Variable, die in diesem Fall dem Umsatz pro Tag entspricht. Auch wenn die lineare Regression im Vergleich modernen statistischen Lernmethoden ein vergleichsweise einfaches Modell ist, ist sie immer noch weit verbreitet. Überdies dient sie als guter Ausgangspunkt für neuere Ansätze: viele neuere statistische Lernansätze können als Generalisierung oder Erweiterung der linearen Regression betrachtet werden.

Im Allgemeinen ist bei der linearen Regression zwischen der einfachen und der multiplen Regression zu unterscheiden. Während im ersten Fall nur eine einzelne Variable als Vorhersageparameter für die abhängige Variable betrachtet wird, werden bei der multiplen linearen Regression mehrere Input-Variablen in das Modell einbezogen. Da hinsichtlich der beeinflussenden Variablen Unterschiede bei den einzelnen Warengruppen zu erwarten sind, werden die Warengruppen isoliert betrachtet. Das heißt, für jede Warengruppe werden unterschiedliche Modelle angewendet und verglichen.

Insgesamt wird Vorgehen wird in mehreren Stufen untergliedert: Zunächst wird auf Basis des allumfassenden Datensatzes df_voll ein Datensatz für die Anwendung der linearen Modelle (df_lm) erstellt und dieser sodann in einen Trainings- und einen Testdatensatz aufgeteilt. In einem nächsten Schritt werden mittels sog. best subset selection und stepwise selection die in das Modell aufzunehmenden Variablen bestimmt und auf dieser Grundlage dann Regressionsmodelle erstellt.

6.2 Datenaufbereitung

Wir arbeiten mit dem vollständigen Datensatz df_voll. Dieser enthält im Zeitraum 01.07.2013 bis 31.07.2019 eine Zeile für jedes Datum und jede Warengruppe. In den Rohdaten fehlende Umsätze sind auf Basis der Vorwochenwerte ergänzt worden. Die Zeilen mit ergänzten Umsätzen sind selektierbar über die Variable Umsatz_NA (= TRUE).

Für unser Vorhaben beschränken wir uns auf die in den Rohdaten vorhandenen Umsätze (Umsatz_NA = FALSE). Und wir schränken die Trainingsdaten später auf den Zeitraum 2015 bis 2017 ein, weil wir oben gesehen hatten, dass die Umsätze in 2014 systematisch höher liegen als in den folgenden Jahren. Die Umsätze des Jahres 2018 dienen uns dann als Testdaten.

Wir erstellen für diesen Abschnitt einen Arbeitsdatensatz df_lm auf Basis von df_voll. Die nicht benötigten Umsatz-Spalten (Umsatz_NA sowie die Umsatz_lag Variablen) werden entfernt. Weiterhin werden Redundanzen eliminiert: der Datensatz enthält sowohl für die Monate als auch für die Wochentage jeweils eine numerische und eine character-Variable. Die numerischen sind für die linearen Modelle unbrauchbar, da dann den eigentlich nominalen Variablen Zahlenwerte zugeordnet würden, die im Rahmen der linearen Modelle auch interpretiert würden. Das würde dazu führen, dass bspw. der Dezember 12x so hoch / stark wie der Januar bewertet wird. Insofern werden die numerischen Variablen für Monat und Wochentag entfernt.

6.2.1 Überprüfung auf lineare Abhängigkeiten der Variablen

Für die Erstellung linearer Modelle dürfen keine linearen Abhängigkeiten zwischen den einzelnen Variablen bestehen. Zunächst ist also zu prüfen, zwischen welchen Variablen lineare Abhängigkeiten bestehen:

## Model :
## Umsatz ~ Datum + Warengruppe + Jahr + KielerWoche + Bewoelkung + 
##     Temperatur + Windgeschwindigkeit + Wochentag_c + Monat_c + 
##     Wochenende + SommerferienSH + SommerferienNRW + SommerferienNDS + 
##     SommerferienHE + Feiertag + Ostern + ChristiHimmelfahrt + 
##     Pfingsten + TDE + Silvester + Ostern_ext + ChristiHimmelfahrt_ext + 
##     Pfingsten_ext + Silvester_ext + Jahreszeit + Fruehling + 
##     Sommer + Herbst + Winter
## 
## Complete :
##            (Intercept) Datum Warengruppe Jahr KielerWoche Bewoelkung
## Wochenende  0           0     0           0    0           0        
## Silvester   0           0     0           0    0           0        
## Fruehling   1           0     0           0    0           0        
## Sommer      0           0     0           0    0           0        
## Herbst      0           0     0           0    0           0        
## Winter      0           0     0           0    0           0        
##            Temperatur Windgeschwindigkeit Wochentag_cDonnerstag
## Wochenende  0          0                   0                   
## Silvester   0          0                   0                   
## Fruehling   0          0                   0                   
## Sommer      0          0                   0                   
## Herbst      0          0                   0                   
## Winter      0          0                   0                   
##            Wochentag_cFreitag Wochentag_cMittwoch Wochentag_cMontag
## Wochenende  0                  0                   0               
## Silvester   0                  0                   0               
## Fruehling   0                  0                   0               
## Sommer      0                  0                   0               
## Herbst      0                  0                   0               
## Winter      0                  0                   0               
##            Wochentag_cSamstag Wochentag_cSonntag Monat_cAugust
## Wochenende  1                  1                  0           
## Silvester   0                  0                  0           
## Fruehling   0                  0                  0           
## Sommer      0                  0                  0           
## Herbst      0                  0                  0           
## Winter      0                  0                  0           
##            Monat_cDezember Monat_cFebruar Monat_cJanuar Monat_cJuli
## Wochenende  0               0              0             0         
## Silvester   0               0              0             0         
## Fruehling   0               0              0             0         
## Sommer      0               0              0             0         
## Herbst      0               0              0             0         
## Winter      0               0              0             0         
##            Monat_cJuni Monat_cMai Monat_cMärz Monat_cNovember
## Wochenende  0           0          0           0             
## Silvester   0           0          0           0             
## Fruehling   0           0          0           0             
## Sommer      0           0          0           0             
## Herbst      0           0          0           0             
## Winter      0           0          0           0             
##            Monat_cOktober Monat_cSeptember SommerferienSH SommerferienNRW
## Wochenende  0              0                0              0             
## Silvester   0              0                0              0             
## Fruehling   0              0                0              0             
## Sommer      0              0                0              0             
## Herbst      0              0                0              0             
## Winter      0              0                0              0             
##            SommerferienNDS SommerferienHE Feiertag Ostern
## Wochenende  0               0              0        0    
## Silvester   0               0              1       -1    
## Fruehling   0               0              0        0    
## Sommer      0               0              0        0    
## Herbst      0               0              0        0    
## Winter      0               0              0        0    
##            ChristiHimmelfahrt Pfingsten TDE Ostern_ext
## Wochenende  0                  0         0   0        
## Silvester  -1                 -1        -1   0        
## Fruehling   0                  0         0   0        
## Sommer      0                  0         0   0        
## Herbst      0                  0         0   0        
## Winter      0                  0         0   0        
##            ChristiHimmelfahrt_ext Pfingsten_ext Silvester_ext
## Wochenende  0                      0             0           
## Silvester   0                      0             0           
## Fruehling   0                      0             0           
## Sommer      0                      0             0           
## Herbst      0                      0             0           
## Winter      0                      0             0           
##            JahreszeitHerbst JahreszeitSommer JahreszeitWinter
## Wochenende  0                0                0              
## Silvester   0                0                0              
## Fruehling  -1               -1               -1              
## Sommer      0                1                0              
## Herbst      1                0                0              
## Winter      0                0                1

Um die linearen Abhängigkeiten zu eliminieren, werden Variablen entfernt:

Erneute Überprüfung:

## Model :
## Umsatz ~ Datum + Warengruppe + Jahr + KielerWoche + Bewoelkung + 
##     Temperatur + Windgeschwindigkeit + Wochentag_c + Monat_c + 
##     SommerferienSH + SommerferienNRW + SommerferienNDS + SommerferienHE + 
##     Feiertag + Ostern + ChristiHimmelfahrt + Pfingsten + TDE + 
##     Ostern_ext + ChristiHimmelfahrt_ext + Pfingsten_ext + Silvester_ext + 
##     Jahreszeit

6.2.3 Überprüfung auf Multikollinearität

Bei der multiplen Regression können zwei oder mehr Prädiktorvariablen miteinander korreliert sein. Diese Situation wird als Kollinearität bezeichnet.

Es gibt eine extreme Situation, die als Multikollinearität bezeichnet wird und in der Kollinearität zwischen drei oder mehr Variablen besteht, selbst wenn kein Variablenpaar eine besonders hohe Korrelation aufweist. Dies bedeutet, dass zwischen Prädiktorvariablen Redundanz besteht.

Bei Vorhandensein von Multikollinearität wird die Lösung des Regressionsmodells instabil.

Multikollinearität kann auf zwei verschiedene Arten überprüft werden:

  • Zum einen kann die Multikollinearität für einen gegebenen Prädiktor (p) bewertet werden, indem ein Score berechnet wird, der als Varianzinflationsfaktor (oder VIF) bezeichnet wird und misst, wie stark die Varianz eines Regressionskoeffizienten aufgrund der Multikollinearität im Modell aufgeblasen wird,
  • zum anderen anhand der Korrelationen der Variablen untereinander.

Der kleinstmögliche Wert von VIF ist eins (Fehlen von Multikollinearität). Als Faustregel gilt, dass ein VIF-Wert, der 5 oder 10 überschreitet, ein problematisches Maß an Kollinearität anzeigt (James et al. 2014).

Bei Multikollinearität sollten die betroffenen Variablen entfernt werden, da das Vorhandensein von Multikollinearität impliziert, dass die Informationen, die diese Variable über die Antwort liefert, bei Vorhandensein der anderen Variablen redundant sind (James et al. 2014, P. Bruce und Bruce (2017)).

Erstellung eines ersten Regressionsmodells

Um eine Überprüfung auf Multikollinearität durchzuführen, wird ein Regressionsmodell erstellt, das alle unabhängigen Variablen enthält:

## Loading required package: lattice
## 
## Attaching package: 'caret'
## The following object is masked from 'package:purrr':
## 
##     lift
##       RMSE        R2
## 1 125.8987 0.1522406

Der \(R^2\)-Wert ist mit 0.152 noch vglw. niedrig; der \(RMSE\) beträgt über alle Warengruppen 125.9.

Überprüfung auf Multikollinearität

Überprüfung mittels VIF

Die R-Funktion vif() [car package] kann genutzt werden um Multikollinearität zu erkennen:

##                                GVIF Df GVIF^(1/(2*Df))
## Datum                  1.437552e+03  1       37.915062
## Warengruppe            1.000025e+00  1        1.000013
## Jahr                   1.295322e+03  1       35.990584
## KielerWoche            1.842369e+00  1        1.357339
## Bewoelkung             1.256308e+00  1        1.120851
## Temperatur             5.496606e+00  1        2.344484
## Windgeschwindigkeit    1.080170e+00  1        1.039312
## Wochentag_c            1.133806e+00  6        1.010520
## Monat_c                1.600820e+05 11        1.724094
## SommerferienSH         4.838550e+00  1        2.199670
## SommerferienNRW        3.639013e+00  1        1.907620
## SommerferienNDS        3.479206e+00  1        1.865263
## SommerferienHE         3.216061e+00  1        1.793338
## Feiertag               1.416233e+01  1        3.763287
## Ostern                 6.441376e+00  1        2.537987
## ChristiHimmelfahrt     3.340415e+00  1        1.827680
## Pfingsten              6.198707e+00  1        2.489720
## TDE                    3.119960e+00  1        1.766341
## Ostern_ext             2.365444e+00  1        1.538000
## ChristiHimmelfahrt_ext 1.466910e+00  1        1.211161
## Pfingsten_ext          2.150779e+00  1        1.466553
## Silvester_ext          2.189628e+00  1        1.479739
## Jahreszeit             2.858888e+02  3        2.566647

Der VIF-Wert für die Variablen Datum und Jahr sind sehr hoch (VIF = 37.915062 respektive 35.990584). Dies könnte problematisch sein. Insofern sollten die Variablen entfernt werden. Dies würde zu einem einfacheren Modell führen, ohne die Modellgenauigkeit zu beeinträchtigen, was gut ist.

Überprüfung durch Korrelation:

Die Korrelationen nach Pearson können in R einfach über den Befehl cor() berechnet werden. Hier sollte kein Wert größer als .7 sein.

##                                 Jahr   KielerWoche   Bewoelkung
## Jahr                    1.0000000000  0.0037131195  0.040489848
## KielerWoche             0.0037131195  1.0000000000 -0.010169489
## Bewoelkung              0.0404898475 -0.0101694893  1.000000000
## Temperatur             -0.0119105107  0.1714359550 -0.359296567
## Windgeschwindigkeit    -0.0368626385  0.0003772206  0.042964334
## SommerferienSH          0.0057160210 -0.0575903882 -0.112608750
## SommerferienNRW         0.0058808588 -0.0597251953 -0.092520351
## SommerferienNDS         0.0014129652  0.0889933065 -0.023319475
## SommerferienHE          0.0011623913 -0.0562887744 -0.089544104
## Feiertag                0.0036382618 -0.0227375516 -0.011467063
## Ostern                  0.0010499763 -0.0121258343 -0.001894188
## ChristiHimmelfahrt      0.0007413892 -0.0085620624 -0.040084695
## Pfingsten               0.0010499763 -0.0121258343 -0.016860067
## TDE                     0.0007413892 -0.0085620624 -0.004859961
## Ostern_ext              0.0037176075 -0.0163057487 -0.014472937
## ChristiHimmelfahrt_ext  0.0016673042 -0.0192551538 -0.115495470
## Pfingsten_ext           0.0036834245 -0.0170520772  0.011485794
## Silvester_ext           0.0041710408 -0.0119208913  0.051747026
##                          Temperatur Windgeschwindigkeit SommerferienSH
## Jahr                   -0.011910511       -0.0368626385    0.005716021
## KielerWoche             0.171435955        0.0003772206   -0.057590388
## Bewoelkung             -0.359296567        0.0429643338   -0.112608750
## Temperatur              1.000000000       -0.0120645003    0.424235994
## Windgeschwindigkeit    -0.012064500        1.0000000000   -0.039982599
## SommerferienSH          0.424235994       -0.0399825988    1.000000000
## SommerferienNRW         0.442095183       -0.0203412230    0.663904053
## SommerferienNDS         0.415536926       -0.0301218240    0.407233003
## SommerferienHE          0.424282177       -0.0578527211    0.672564795
## Feiertag               -0.008045139        0.0336145412   -0.050783590
## Ostern                 -0.038164531        0.0055246913   -0.027082661
## ChristiHimmelfahrt      0.025126030        0.0081566874   -0.019123091
## Pfingsten               0.024712144        0.0085382110   -0.027082661
## TDE                     0.019752296        0.0336908750   -0.019123091
## Ostern_ext             -0.050832958        0.0601092060   -0.036418365
## ChristiHimmelfahrt_ext  0.088386968        0.0393988405   -0.043005767
## Pfingsten_ext           0.037386236        0.0070508831   -0.038085266
## Silvester_ext          -0.078694007        0.0062485820   -0.026624927
##                        SommerferienNRW SommerferienNDS SommerferienHE
## Jahr                       0.005880859     0.001412965    0.001162391
## KielerWoche               -0.059725195     0.088993306   -0.056288774
## Bewoelkung                -0.092520351    -0.023319475   -0.089544104
## Temperatur                 0.442095183     0.415536926    0.424282177
## Windgeschwindigkeit       -0.020341223    -0.030121824   -0.057852721
## SommerferienSH             0.663904053     0.407233003    0.672564795
## SommerferienNRW            1.000000000     0.405753907    0.571878261
## SommerferienNDS            0.405753907     1.000000000    0.665698954
## SommerferienHE             0.571878261     0.665698954    1.000000000
## Feiertag                  -0.052666077    -0.051257648   -0.049635818
## Ostern                    -0.028086583    -0.027335474   -0.026470559
## ChristiHimmelfahrt        -0.019831961    -0.019301602   -0.018690886
## Pfingsten                 -0.028086583    -0.027335474   -0.026470559
## TDE                       -0.019831961    -0.019301602   -0.018690886
## Ostern_ext                -0.037768351    -0.036758326   -0.035595265
## ChristiHimmelfahrt_ext    -0.044599939    -0.043407220   -0.042033783
## Pfingsten_ext             -0.039497041    -0.038440787   -0.037224492
## Silvester_ext             -0.027611882    -0.026873467   -0.026023171
##                            Feiertag       Ostern ChristiHimmelfahrt
## Jahr                    0.003638262  0.001049976       0.0007413892
## KielerWoche            -0.022737552 -0.012125834      -0.0085620624
## Bewoelkung             -0.011467063 -0.001894188      -0.0400846950
## Temperatur             -0.008045139 -0.038164531       0.0251260295
## Windgeschwindigkeit     0.033614541  0.005524691       0.0081566874
## SommerferienSH         -0.050783590 -0.027082661      -0.0191230910
## SommerferienNRW        -0.052666077 -0.028086583      -0.0198319611
## SommerferienNDS        -0.051257648 -0.027335474      -0.0193016024
## SommerferienHE         -0.049635818 -0.026470559      -0.0186908855
## Feiertag                1.000000000  0.533295514       0.3765604380
## Ostern                  0.533295514  1.000000000      -0.0040264259
## ChristiHimmelfahrt      0.376560438 -0.004026426       1.0000000000
## Pfingsten               0.533295514 -0.005702338      -0.0040264259
## TDE                     0.376560438 -0.004026426      -0.0028430629
## Ostern_ext              0.392014329  0.743653940      -0.0054143812
## ChristiHimmelfahrt_ext  0.155785294 -0.009054997       0.4446634116
## Pfingsten_ext           0.373940746 -0.008018970      -0.0056622022
## Silvester_ext           0.247664503 -0.005605961      -0.0039583739
##                           Pfingsten           TDE   Ostern_ext
## Jahr                    0.001049976  0.0007413892  0.003717608
## KielerWoche            -0.012125834 -0.0085620624 -0.016305749
## Bewoelkung             -0.016860067 -0.0048599614 -0.014472937
## Temperatur              0.024712144  0.0197522958 -0.050832958
## Windgeschwindigkeit     0.008538211  0.0336908750  0.060109206
## SommerferienSH         -0.027082661 -0.0191230910 -0.036418365
## SommerferienNRW        -0.028086583 -0.0198319611 -0.037768351
## SommerferienNDS        -0.027335474 -0.0193016024 -0.036758326
## SommerferienHE         -0.026470559 -0.0186908855 -0.035595265
## Feiertag                0.533295514  0.3765604380  0.392014329
## Ostern                 -0.005702338 -0.0040264259  0.743653940
## ChristiHimmelfahrt     -0.004026426 -0.0028430629 -0.005414381
## Pfingsten               1.000000000 -0.0040264259 -0.007667999
## TDE                    -0.004026426  1.0000000000 -0.005414381
## Ostern_ext             -0.007667999 -0.0054143812  1.000000000
## ChristiHimmelfahrt_ext -0.009054997 -0.0063937415 -0.012176359
## Pfingsten_ext           0.711105992 -0.0056622022 -0.010783202
## Silvester_ext          -0.005605961 -0.0039583739 -0.007538400
##                        ChristiHimmelfahrt_ext Pfingsten_ext Silvester_ext
## Jahr                              0.001667304   0.003683425   0.004171041
## KielerWoche                      -0.019255154  -0.017052077  -0.011920891
## Bewoelkung                       -0.115495470   0.011485794   0.051747026
## Temperatur                        0.088386968   0.037386236  -0.078694007
## Windgeschwindigkeit               0.039398841   0.007050883   0.006248582
## SommerferienSH                   -0.043005767  -0.038085266  -0.026624927
## SommerferienNRW                  -0.044599939  -0.039497041  -0.027611882
## SommerferienNDS                  -0.043407220  -0.038440787  -0.026873467
## SommerferienHE                   -0.042033783  -0.037224492  -0.026023171
## Feiertag                          0.155785294   0.373940746   0.247664503
## Ostern                           -0.009054997  -0.008018970  -0.005605961
## ChristiHimmelfahrt                0.444663412  -0.005662202  -0.003958374
## Pfingsten                        -0.009054997   0.711105992  -0.005605961
## TDE                              -0.006393742  -0.005662202  -0.003958374
## Ostern_ext                       -0.012176359  -0.010783202  -0.007538400
## ChristiHimmelfahrt_ext            1.000000000  -0.012733681  -0.008901955
## Pfingsten_ext                    -0.012733681   1.000000000  -0.007883439
## Silvester_ext                    -0.008901955  -0.007883439   1.000000000

Einige der unabhängigen Variablen weisen starke bis mittelstarke Korrelationen auf (auf 3 Stellen gerundet):

  • SommerferienSH und SommerferienNRW: 0.663904053
  • SommerferienNRW und SommerferienHE: 0.571878261
  • SommerferienSH und SommerferienHE: 0.672564795
  • SommerferienNDS und SommerferienHE: 0.665698954
  • Feiertag und Ostern: 0.533295514
  • Feiertag und Pfingsten: 0.533295514
  • Ostern und Ostern_ext: 0.743653940
  • Pfingsten und Pfingsten_ext: 0.711105992

Da die Einflussvariablen mitunter stark korrelieren und die Grenze von .7 teilweise fast ankratzen und teilweise überschreiten, muss in Erwägung gezogen werden, auch einge der stark miteinander korrelierten Variablen zu eliminieren, da bspw. die schrittweise Regression bei Multikollinearität versagt. Zunächst werden die Tatsache, dass einzelne Variablen stark untereinander korrelieren, jedoch ignoriert. Eine sich doch als notwendig abzeichnende Eliminierung weiterer Variablen erfolgt ggf. zu einem späteren Zeitpunkt.

Umgang mit Multikollinearität

In diesem Abschnitt, wird das Modell erneut erstellt. Dieses Mal zunächst nur ohne die beiden problematischen Variablen Datum und Jahr.

##       RMSE        R2
## 1 124.2938 0.1524634

Man kann sehen, dass das Entfernen der beiden Variablen Datum und Jahr die Modellleistungsmetriken nicht sehr beeinflusst (RMSE inkl. Datum und Jahr: 125.8987, R2: 0.1522406). Mit anderen Worten, die Modellgenauigkeit leidet nur marginal unter dem Entfernen der beiden Variablen.

6.3 Erstellung linearer Regressionsmodelle für die einzelnen Warengruppen

Laden der benötigten Pakete

Wir beginnen unsere Analyse mit dem Laden der notwendigen Pakete, die bislang noch nicht geladen wurden:

  • caret für einen einfachen Machine Learning workflow
  • leaps für die Berechnung einer schrittweisen Regression

6.3.1 Warengruppe 1

Erstellung von Trainings- und Testdatensätzen für Warengruppe 1

Auswahl der am besten geeigneten Variablen

Beste Teilmengenauswahl (“Best subset selection”)

Um die beste Teilmengenauswahl durchzuführen, passen wir für jede mögliche Kombination der \(p\) Prädiktoren eine separate Regression der kleinsten Quadrate an. Das heißt, wir passen alle \(p\)-Modelle an, die genau einen Prädiktor enthalten, alle \(\binom{p}{2} = p (p - 1) / 2\)-Modelle, die genau zwei Prädiktoren enthalten, und so weiter. Wir betrachten dann alle resultierenden Modelle mit dem Ziel, das beste zu identifizieren.

Der dreistufige Prozess zur Durchführung der Auswahl der besten Teilmenge umfasst:

Schritt 1: Bezeichne \(M_0\) das Nullmodell, das keine Prädiktoren enthält. Dieses Modell sagt einfach den Stichprobenmittelwert für jede Beobachtung voraus.

Schritt 2: Für \(k = 1,2,… p\):

  • Passe alle \(\binom{p}{k}\) Modelle an, die genau \(k\) Prädiktoren enthalten.
  • Wähle die besten unter diesen \(\binom{p}{k}\) Modelle, und nenne es \(M_{k}\). Hier wird “beste Modelle” in der Form definiert, dass diese die kleinsten RSS (residual sum of squares, Quadratssumme der Residuen) oder äquivalent die größten \(R^2\)-Werte haben.

Schritt 3: Wähle aus \(M_0, .. , M_p\) ein einzelnes bestes Modell aus unter Verwendung eines kreuzvalidierten Vorhersagefehlers (cross validated prediction error), \(Cp\), \(AIC\), \(BIC\) oder adjustiertem \(R^2\).

Die Suche nach den besten Teilmengen an Prädikatorvariablen kann mithilfe von regsubsets (Teil der leaps-Bibliothek) durchgeführt werden. regsubsets identifiziert das beste Modell für eine bestimmte/festgelegte Anzahl von k Prädiktoren, wobei “das Beste” mithilfe von RSS quantifiziert wird. Die Syntax entspricht der lm-Funktion. Standardmäßig meldet regsubsets nur Ergebnisse bis zum besten Modell mit acht Variablen. Die Option nvmax kann jedoch verwendet werden, um so viele Variablen wie gewünscht zurückzugeben. Hier passen wir zu einem Modell mit 37 Variablen.

Die regsubsets-Funktion gibt ein Listenobjekt mit vielen Informationen zurück. Zunächst kann der Befehl summary verwendet werden, um den besten Satz von Variablen für jede Modellgröße zu ermitteln.

## Subset selection object
## Call: regsubsets.formula(Umsatz ~ ., df_lm_train_WG1, nvmax = 37)
## 37 Variables  (and intercept)
##                        Forced in Forced out
## KielerWoche                FALSE      FALSE
## Bewoelkung                 FALSE      FALSE
## Temperatur                 FALSE      FALSE
## Windgeschwindigkeit        FALSE      FALSE
## Wochentag_cDonnerstag      FALSE      FALSE
## Wochentag_cFreitag         FALSE      FALSE
## Wochentag_cMittwoch        FALSE      FALSE
## Wochentag_cMontag          FALSE      FALSE
## Wochentag_cSamstag         FALSE      FALSE
## Wochentag_cSonntag         FALSE      FALSE
## Monat_cAugust              FALSE      FALSE
## Monat_cDezember            FALSE      FALSE
## Monat_cFebruar             FALSE      FALSE
## Monat_cJanuar              FALSE      FALSE
## Monat_cJuli                FALSE      FALSE
## Monat_cJuni                FALSE      FALSE
## Monat_cMai                 FALSE      FALSE
## Monat_cMärz                FALSE      FALSE
## Monat_cNovember            FALSE      FALSE
## Monat_cOktober             FALSE      FALSE
## Monat_cSeptember           FALSE      FALSE
## SommerferienSH             FALSE      FALSE
## SommerferienNRW            FALSE      FALSE
## SommerferienNDS            FALSE      FALSE
## SommerferienHE             FALSE      FALSE
## Feiertag                   FALSE      FALSE
## Ostern                     FALSE      FALSE
## ChristiHimmelfahrt         FALSE      FALSE
## Pfingsten                  FALSE      FALSE
## TDE                        FALSE      FALSE
## Ostern_ext                 FALSE      FALSE
## ChristiHimmelfahrt_ext     FALSE      FALSE
## Pfingsten_ext              FALSE      FALSE
## Silvester_ext              FALSE      FALSE
## JahreszeitHerbst           FALSE      FALSE
## JahreszeitSommer           FALSE      FALSE
## JahreszeitWinter           FALSE      FALSE
## 1 subsets of each size up to 37
## Selection Algorithm: exhaustive
##           KielerWoche Bewoelkung Temperatur Windgeschwindigkeit
## 1  ( 1 )  " "         " "        " "        " "                
## 2  ( 1 )  " "         " "        " "        " "                
## 3  ( 1 )  " "         " "        " "        " "                
## 4  ( 1 )  " "         " "        " "        " "                
## 5  ( 1 )  " "         " "        " "        " "                
## 6  ( 1 )  " "         " "        " "        " "                
## 7  ( 1 )  " "         " "        "*"        " "                
## 8  ( 1 )  " "         " "        "*"        " "                
## 9  ( 1 )  " "         " "        "*"        " "                
## 10  ( 1 ) " "         " "        "*"        " "                
## 11  ( 1 ) " "         " "        "*"        " "                
## 12  ( 1 ) " "         " "        "*"        " "                
## 13  ( 1 ) " "         " "        "*"        " "                
## 14  ( 1 ) " "         " "        "*"        " "                
## 15  ( 1 ) " "         " "        " "        " "                
## 16  ( 1 ) " "         " "        " "        " "                
## 17  ( 1 ) " "         " "        " "        " "                
## 18  ( 1 ) " "         " "        " "        " "                
## 19  ( 1 ) " "         " "        " "        " "                
## 20  ( 1 ) "*"         " "        " "        " "                
## 21  ( 1 ) "*"         " "        " "        " "                
## 22  ( 1 ) "*"         " "        " "        " "                
## 23  ( 1 ) "*"         " "        " "        " "                
## 24  ( 1 ) "*"         " "        " "        " "                
## 25  ( 1 ) "*"         " "        " "        " "                
## 26  ( 1 ) "*"         " "        " "        " "                
## 27  ( 1 ) "*"         " "        " "        " "                
## 28  ( 1 ) "*"         "*"        "*"        " "                
## 29  ( 1 ) "*"         "*"        "*"        " "                
## 30  ( 1 ) "*"         "*"        "*"        " "                
## 31  ( 1 ) "*"         "*"        "*"        " "                
## 32  ( 1 ) "*"         "*"        "*"        " "                
## 33  ( 1 ) "*"         "*"        "*"        "*"                
## 34  ( 1 ) "*"         "*"        "*"        "*"                
## 35  ( 1 ) "*"         "*"        "*"        "*"                
## 36  ( 1 ) "*"         "*"        "*"        "*"                
## 37  ( 1 ) "*"         "*"        "*"        "*"                
##           Wochentag_cDonnerstag Wochentag_cFreitag Wochentag_cMittwoch
## 1  ( 1 )  " "                   " "                " "                
## 2  ( 1 )  " "                   " "                " "                
## 3  ( 1 )  " "                   " "                " "                
## 4  ( 1 )  " "                   " "                " "                
## 5  ( 1 )  " "                   " "                " "                
## 6  ( 1 )  " "                   " "                " "                
## 7  ( 1 )  " "                   " "                " "                
## 8  ( 1 )  " "                   " "                "*"                
## 9  ( 1 )  " "                   " "                "*"                
## 10  ( 1 ) "*"                   "*"                " "                
## 11  ( 1 ) "*"                   "*"                " "                
## 12  ( 1 ) "*"                   "*"                " "                
## 13  ( 1 ) "*"                   "*"                " "                
## 14  ( 1 ) "*"                   "*"                " "                
## 15  ( 1 ) "*"                   "*"                " "                
## 16  ( 1 ) "*"                   "*"                " "                
## 17  ( 1 ) "*"                   "*"                " "                
## 18  ( 1 ) "*"                   "*"                " "                
## 19  ( 1 ) "*"                   "*"                " "                
## 20  ( 1 ) "*"                   "*"                " "                
## 21  ( 1 ) "*"                   "*"                " "                
## 22  ( 1 ) "*"                   "*"                " "                
## 23  ( 1 ) "*"                   "*"                " "                
## 24  ( 1 ) "*"                   "*"                " "                
## 25  ( 1 ) "*"                   "*"                " "                
## 26  ( 1 ) "*"                   "*"                " "                
## 27  ( 1 ) "*"                   "*"                " "                
## 28  ( 1 ) "*"                   "*"                " "                
## 29  ( 1 ) "*"                   "*"                " "                
## 30  ( 1 ) "*"                   "*"                "*"                
## 31  ( 1 ) "*"                   "*"                "*"                
## 32  ( 1 ) "*"                   "*"                "*"                
## 33  ( 1 ) "*"                   "*"                "*"                
## 34  ( 1 ) "*"                   "*"                "*"                
## 35  ( 1 ) "*"                   "*"                "*"                
## 36  ( 1 ) "*"                   "*"                "*"                
## 37  ( 1 ) "*"                   "*"                "*"                
##           Wochentag_cMontag Wochentag_cSamstag Wochentag_cSonntag
## 1  ( 1 )  " "               " "                "*"               
## 2  ( 1 )  " "               " "                "*"               
## 3  ( 1 )  " "               " "                "*"               
## 4  ( 1 )  " "               " "                "*"               
## 5  ( 1 )  " "               "*"                "*"               
## 6  ( 1 )  " "               "*"                "*"               
## 7  ( 1 )  " "               "*"                "*"               
## 8  ( 1 )  " "               "*"                "*"               
## 9  ( 1 )  " "               "*"                "*"               
## 10  ( 1 ) "*"               "*"                "*"               
## 11  ( 1 ) "*"               "*"                "*"               
## 12  ( 1 ) "*"               "*"                "*"               
## 13  ( 1 ) "*"               "*"                "*"               
## 14  ( 1 ) "*"               "*"                "*"               
## 15  ( 1 ) "*"               "*"                "*"               
## 16  ( 1 ) "*"               "*"                "*"               
## 17  ( 1 ) "*"               "*"                "*"               
## 18  ( 1 ) "*"               "*"                "*"               
## 19  ( 1 ) "*"               "*"                "*"               
## 20  ( 1 ) "*"               "*"                "*"               
## 21  ( 1 ) "*"               "*"                "*"               
## 22  ( 1 ) "*"               "*"                "*"               
## 23  ( 1 ) "*"               "*"                "*"               
## 24  ( 1 ) "*"               "*"                "*"               
## 25  ( 1 ) "*"               "*"                "*"               
## 26  ( 1 ) "*"               "*"                "*"               
## 27  ( 1 ) "*"               "*"                "*"               
## 28  ( 1 ) "*"               "*"                "*"               
## 29  ( 1 ) "*"               "*"                "*"               
## 30  ( 1 ) "*"               "*"                "*"               
## 31  ( 1 ) "*"               "*"                "*"               
## 32  ( 1 ) "*"               "*"                "*"               
## 33  ( 1 ) "*"               "*"                "*"               
## 34  ( 1 ) "*"               "*"                "*"               
## 35  ( 1 ) "*"               "*"                "*"               
## 36  ( 1 ) "*"               "*"                "*"               
## 37  ( 1 ) "*"               "*"                "*"               
##           Monat_cAugust Monat_cDezember Monat_cFebruar Monat_cJanuar
## 1  ( 1 )  " "           " "             " "            " "          
## 2  ( 1 )  " "           " "             " "            " "          
## 3  ( 1 )  " "           " "             " "            " "          
## 4  ( 1 )  " "           " "             " "            " "          
## 5  ( 1 )  " "           " "             " "            " "          
## 6  ( 1 )  " "           " "             " "            " "          
## 7  ( 1 )  " "           " "             " "            " "          
## 8  ( 1 )  " "           " "             " "            " "          
## 9  ( 1 )  " "           " "             " "            " "          
## 10  ( 1 ) " "           " "             " "            " "          
## 11  ( 1 ) " "           " "             " "            " "          
## 12  ( 1 ) " "           " "             " "            " "          
## 13  ( 1 ) " "           " "             " "            " "          
## 14  ( 1 ) " "           " "             " "            " "          
## 15  ( 1 ) " "           " "             "*"            "*"          
## 16  ( 1 ) " "           " "             "*"            "*"          
## 17  ( 1 ) " "           " "             "*"            "*"          
## 18  ( 1 ) " "           " "             "*"            "*"          
## 19  ( 1 ) " "           " "             "*"            "*"          
## 20  ( 1 ) " "           " "             "*"            "*"          
## 21  ( 1 ) " "           " "             "*"            "*"          
## 22  ( 1 ) " "           " "             "*"            "*"          
## 23  ( 1 ) " "           " "             "*"            "*"          
## 24  ( 1 ) " "           " "             "*"            "*"          
## 25  ( 1 ) " "           "*"             "*"            "*"          
## 26  ( 1 ) " "           "*"             "*"            "*"          
## 27  ( 1 ) " "           "*"             "*"            "*"          
## 28  ( 1 ) " "           " "             "*"            "*"          
## 29  ( 1 ) " "           "*"             "*"            "*"          
## 30  ( 1 ) " "           "*"             "*"            "*"          
## 31  ( 1 ) " "           "*"             "*"            "*"          
## 32  ( 1 ) " "           "*"             "*"            "*"          
## 33  ( 1 ) " "           "*"             "*"            "*"          
## 34  ( 1 ) " "           "*"             "*"            "*"          
## 35  ( 1 ) " "           "*"             "*"            "*"          
## 36  ( 1 ) "*"           "*"             "*"            "*"          
## 37  ( 1 ) "*"           "*"             "*"            "*"          
##           Monat_cJuli Monat_cJuni Monat_cMai Monat_cMärz Monat_cNovember
## 1  ( 1 )  " "         " "         " "        " "         " "            
## 2  ( 1 )  " "         " "         " "        " "         " "            
## 3  ( 1 )  " "         " "         " "        " "         " "            
## 4  ( 1 )  " "         " "         " "        " "         " "            
## 5  ( 1 )  " "         " "         " "        " "         " "            
## 6  ( 1 )  " "         " "         " "        " "         " "            
## 7  ( 1 )  " "         " "         " "        " "         " "            
## 8  ( 1 )  " "         " "         " "        " "         " "            
## 9  ( 1 )  " "         " "         " "        " "         " "            
## 10  ( 1 ) " "         " "         " "        " "         " "            
## 11  ( 1 ) " "         " "         " "        " "         " "            
## 12  ( 1 ) " "         " "         " "        " "         " "            
## 13  ( 1 ) " "         " "         " "        " "         " "            
## 14  ( 1 ) " "         " "         " "        " "         " "            
## 15  ( 1 ) " "         " "         " "        " "         " "            
## 16  ( 1 ) " "         " "         " "        " "         " "            
## 17  ( 1 ) " "         " "         " "        " "         " "            
## 18  ( 1 ) " "         " "         " "        "*"         " "            
## 19  ( 1 ) " "         " "         " "        "*"         " "            
## 20  ( 1 ) " "         " "         " "        " "         " "            
## 21  ( 1 ) " "         " "         " "        " "         " "            
## 22  ( 1 ) " "         " "         " "        "*"         " "            
## 23  ( 1 ) " "         " "         " "        "*"         " "            
## 24  ( 1 ) " "         " "         " "        "*"         " "            
## 25  ( 1 ) " "         " "         " "        " "         "*"            
## 26  ( 1 ) " "         " "         " "        "*"         "*"            
## 27  ( 1 ) " "         " "         " "        "*"         "*"            
## 28  ( 1 ) " "         " "         " "        "*"         " "            
## 29  ( 1 ) " "         " "         " "        "*"         "*"            
## 30  ( 1 ) " "         " "         " "        "*"         "*"            
## 31  ( 1 ) " "         "*"         " "        "*"         "*"            
## 32  ( 1 ) " "         "*"         " "        "*"         "*"            
## 33  ( 1 ) " "         "*"         " "        "*"         "*"            
## 34  ( 1 ) " "         "*"         " "        "*"         "*"            
## 35  ( 1 ) " "         "*"         "*"        "*"         "*"            
## 36  ( 1 ) " "         "*"         "*"        "*"         "*"            
## 37  ( 1 ) "*"         "*"         "*"        "*"         "*"            
##           Monat_cOktober Monat_cSeptember SommerferienSH SommerferienNRW
## 1  ( 1 )  " "            " "              " "            " "            
## 2  ( 1 )  " "            " "              "*"            " "            
## 3  ( 1 )  " "            " "              " "            " "            
## 4  ( 1 )  " "            " "              "*"            " "            
## 5  ( 1 )  " "            " "              " "            " "            
## 6  ( 1 )  " "            " "              " "            " "            
## 7  ( 1 )  " "            " "              "*"            " "            
## 8  ( 1 )  " "            " "              "*"            " "            
## 9  ( 1 )  " "            " "              "*"            " "            
## 10  ( 1 ) " "            " "              "*"            " "            
## 11  ( 1 ) " "            " "              "*"            " "            
## 12  ( 1 ) " "            " "              "*"            " "            
## 13  ( 1 ) " "            " "              "*"            " "            
## 14  ( 1 ) " "            " "              "*"            " "            
## 15  ( 1 ) " "            " "              "*"            " "            
## 16  ( 1 ) "*"            " "              "*"            " "            
## 17  ( 1 ) "*"            " "              "*"            " "            
## 18  ( 1 ) "*"            " "              "*"            " "            
## 19  ( 1 ) "*"            " "              "*"            "*"            
## 20  ( 1 ) "*"            "*"              "*"            "*"            
## 21  ( 1 ) "*"            "*"              "*"            "*"            
## 22  ( 1 ) "*"            "*"              "*"            "*"            
## 23  ( 1 ) "*"            "*"              "*"            "*"            
## 24  ( 1 ) "*"            "*"              "*"            "*"            
## 25  ( 1 ) "*"            "*"              "*"            "*"            
## 26  ( 1 ) "*"            "*"              "*"            "*"            
## 27  ( 1 ) "*"            "*"              "*"            "*"            
## 28  ( 1 ) "*"            "*"              "*"            "*"            
## 29  ( 1 ) "*"            "*"              "*"            "*"            
## 30  ( 1 ) "*"            "*"              "*"            "*"            
## 31  ( 1 ) "*"            "*"              "*"            "*"            
## 32  ( 1 ) "*"            "*"              "*"            "*"            
## 33  ( 1 ) "*"            "*"              "*"            "*"            
## 34  ( 1 ) "*"            "*"              "*"            "*"            
## 35  ( 1 ) "*"            "*"              "*"            "*"            
## 36  ( 1 ) "*"            "*"              "*"            "*"            
## 37  ( 1 ) "*"            "*"              "*"            "*"            
##           SommerferienNDS SommerferienHE Feiertag Ostern
## 1  ( 1 )  " "             " "            " "      " "   
## 2  ( 1 )  " "             " "            " "      " "   
## 3  ( 1 )  " "             " "            " "      "*"   
## 4  ( 1 )  " "             " "            " "      "*"   
## 5  ( 1 )  " "             " "            " "      "*"   
## 6  ( 1 )  " "             " "            " "      "*"   
## 7  ( 1 )  " "             " "            " "      "*"   
## 8  ( 1 )  " "             " "            " "      "*"   
## 9  ( 1 )  " "             " "            " "      "*"   
## 10  ( 1 ) " "             " "            " "      "*"   
## 11  ( 1 ) " "             " "            " "      "*"   
## 12  ( 1 ) " "             " "            " "      "*"   
## 13  ( 1 ) " "             " "            "*"      "*"   
## 14  ( 1 ) "*"             " "            "*"      "*"   
## 15  ( 1 ) " "             " "            "*"      "*"   
## 16  ( 1 ) " "             " "            "*"      "*"   
## 17  ( 1 ) "*"             " "            "*"      "*"   
## 18  ( 1 ) "*"             " "            "*"      "*"   
## 19  ( 1 ) "*"             " "            "*"      "*"   
## 20  ( 1 ) "*"             " "            "*"      "*"   
## 21  ( 1 ) "*"             " "            "*"      "*"   
## 22  ( 1 ) "*"             " "            "*"      "*"   
## 23  ( 1 ) "*"             " "            "*"      "*"   
## 24  ( 1 ) "*"             " "            "*"      "*"   
## 25  ( 1 ) "*"             " "            "*"      "*"   
## 26  ( 1 ) "*"             " "            "*"      "*"   
## 27  ( 1 ) "*"             "*"            "*"      "*"   
## 28  ( 1 ) "*"             "*"            "*"      "*"   
## 29  ( 1 ) "*"             "*"            "*"      "*"   
## 30  ( 1 ) "*"             "*"            "*"      "*"   
## 31  ( 1 ) "*"             "*"            "*"      "*"   
## 32  ( 1 ) "*"             "*"            "*"      "*"   
## 33  ( 1 ) "*"             "*"            "*"      "*"   
## 34  ( 1 ) "*"             "*"            "*"      "*"   
## 35  ( 1 ) "*"             "*"            "*"      "*"   
## 36  ( 1 ) "*"             "*"            "*"      "*"   
## 37  ( 1 ) "*"             "*"            "*"      "*"   
##           ChristiHimmelfahrt Pfingsten TDE Ostern_ext
## 1  ( 1 )  " "                " "       " " " "       
## 2  ( 1 )  " "                " "       " " " "       
## 3  ( 1 )  " "                " "       " " "*"       
## 4  ( 1 )  " "                " "       " " "*"       
## 5  ( 1 )  " "                " "       " " "*"       
## 6  ( 1 )  " "                " "       " " "*"       
## 7  ( 1 )  " "                " "       " " "*"       
## 8  ( 1 )  " "                " "       " " "*"       
## 9  ( 1 )  " "                " "       "*" "*"       
## 10  ( 1 ) " "                " "       " " "*"       
## 11  ( 1 ) "*"                " "       " " "*"       
## 12  ( 1 ) "*"                " "       "*" "*"       
## 13  ( 1 ) "*"                "*"       "*" "*"       
## 14  ( 1 ) "*"                "*"       "*" "*"       
## 15  ( 1 ) "*"                "*"       "*" "*"       
## 16  ( 1 ) "*"                "*"       "*" "*"       
## 17  ( 1 ) "*"                "*"       "*" "*"       
## 18  ( 1 ) "*"                "*"       "*" "*"       
## 19  ( 1 ) "*"                "*"       "*" "*"       
## 20  ( 1 ) "*"                "*"       "*" "*"       
## 21  ( 1 ) "*"                "*"       "*" "*"       
## 22  ( 1 ) "*"                "*"       "*" "*"       
## 23  ( 1 ) "*"                "*"       "*" "*"       
## 24  ( 1 ) "*"                "*"       "*" "*"       
## 25  ( 1 ) "*"                "*"       "*" "*"       
## 26  ( 1 ) "*"                "*"       "*" "*"       
## 27  ( 1 ) "*"                "*"       "*" "*"       
## 28  ( 1 ) "*"                "*"       "*" "*"       
## 29  ( 1 ) "*"                "*"       "*" "*"       
## 30  ( 1 ) "*"                "*"       "*" "*"       
## 31  ( 1 ) "*"                "*"       "*" "*"       
## 32  ( 1 ) "*"                "*"       "*" "*"       
## 33  ( 1 ) "*"                "*"       "*" "*"       
## 34  ( 1 ) "*"                "*"       "*" "*"       
## 35  ( 1 ) "*"                "*"       "*" "*"       
## 36  ( 1 ) "*"                "*"       "*" "*"       
## 37  ( 1 ) "*"                "*"       "*" "*"       
##           ChristiHimmelfahrt_ext Pfingsten_ext Silvester_ext
## 1  ( 1 )  " "                    " "           " "          
## 2  ( 1 )  " "                    " "           " "          
## 3  ( 1 )  " "                    " "           " "          
## 4  ( 1 )  " "                    " "           " "          
## 5  ( 1 )  " "                    " "           " "          
## 6  ( 1 )  " "                    " "           "*"          
## 7  ( 1 )  " "                    " "           "*"          
## 8  ( 1 )  " "                    " "           "*"          
## 9  ( 1 )  " "                    " "           "*"          
## 10  ( 1 ) " "                    " "           "*"          
## 11  ( 1 ) " "                    " "           "*"          
## 12  ( 1 ) " "                    " "           "*"          
## 13  ( 1 ) " "                    " "           " "          
## 14  ( 1 ) " "                    " "           " "          
## 15  ( 1 ) " "                    " "           " "          
## 16  ( 1 ) " "                    " "           " "          
## 17  ( 1 ) " "                    " "           " "          
## 18  ( 1 ) " "                    " "           " "          
## 19  ( 1 ) " "                    " "           " "          
## 20  ( 1 ) " "                    " "           " "          
## 21  ( 1 ) " "                    "*"           " "          
## 22  ( 1 ) " "                    " "           " "          
## 23  ( 1 ) " "                    "*"           " "          
## 24  ( 1 ) " "                    "*"           " "          
## 25  ( 1 ) "*"                    "*"           " "          
## 26  ( 1 ) "*"                    "*"           " "          
## 27  ( 1 ) "*"                    "*"           " "          
## 28  ( 1 ) "*"                    "*"           " "          
## 29  ( 1 ) "*"                    "*"           " "          
## 30  ( 1 ) "*"                    "*"           " "          
## 31  ( 1 ) "*"                    "*"           " "          
## 32  ( 1 ) "*"                    "*"           " "          
## 33  ( 1 ) "*"                    "*"           " "          
## 34  ( 1 ) "*"                    "*"           "*"          
## 35  ( 1 ) "*"                    "*"           "*"          
## 36  ( 1 ) "*"                    "*"           "*"          
## 37  ( 1 ) "*"                    "*"           "*"          
##           JahreszeitHerbst JahreszeitSommer JahreszeitWinter
## 1  ( 1 )  " "              " "              " "             
## 2  ( 1 )  " "              " "              " "             
## 3  ( 1 )  " "              " "              " "             
## 4  ( 1 )  " "              " "              " "             
## 5  ( 1 )  " "              "*"              " "             
## 6  ( 1 )  " "              "*"              " "             
## 7  ( 1 )  " "              " "              " "             
## 8  ( 1 )  " "              " "              " "             
## 9  ( 1 )  " "              " "              " "             
## 10  ( 1 ) " "              " "              " "             
## 11  ( 1 ) " "              " "              " "             
## 12  ( 1 ) " "              " "              " "             
## 13  ( 1 ) " "              " "              " "             
## 14  ( 1 ) " "              " "              " "             
## 15  ( 1 ) "*"              " "              " "             
## 16  ( 1 ) "*"              " "              " "             
## 17  ( 1 ) "*"              " "              " "             
## 18  ( 1 ) "*"              " "              " "             
## 19  ( 1 ) "*"              " "              " "             
## 20  ( 1 ) "*"              " "              " "             
## 21  ( 1 ) "*"              " "              " "             
## 22  ( 1 ) "*"              "*"              " "             
## 23  ( 1 ) "*"              "*"              " "             
## 24  ( 1 ) "*"              "*"              "*"             
## 25  ( 1 ) "*"              "*"              " "             
## 26  ( 1 ) "*"              "*"              " "             
## 27  ( 1 ) "*"              "*"              " "             
## 28  ( 1 ) "*"              "*"              "*"             
## 29  ( 1 ) "*"              "*"              " "             
## 30  ( 1 ) "*"              "*"              " "             
## 31  ( 1 ) "*"              "*"              " "             
## 32  ( 1 ) "*"              "*"              "*"             
## 33  ( 1 ) "*"              "*"              "*"             
## 34  ( 1 ) "*"              "*"              "*"             
## 35  ( 1 ) "*"              "*"              "*"             
## 36  ( 1 ) "*"              "*"              "*"             
## 37  ( 1 ) "*"              "*"              "*"

Für ein Modell mit einer Variablen kann beobachtet werden, dass die erzeugte Dummy-Variable Wochentag_cSonntag ein Sternchen hat, was signalisiert, dass ein Regressionsmodell mit Umsatz ~ Wochentag_cSonntag das beste Einzelvariablenmodell ist. Das beste 2-Variablen-Modell ist Umsatz ~ Wochentag_cSonntag + SommerferienSH. Das beste 3-Variablen-Modell ist Umsatz ~ Wochentag_cSonntag + Ostern + Ostern_ext. Und so weiter.

Man kann auch \(RSS\), \(R^2\), adjustiertes \(R^2\), \(C_{p}\) und \(BIC\) aus den Ergebnissen abrufen, um das beste Gesamtmodell zu bewerten. Dies wird jedoch im Abschnitt zum Vergleichen von Modellen veranschaulicht. Schauen wir uns zunächst an, wie die schrittweise Auswahl durchgeführt wird.

Schrittweise Auswahl (“Stepwise selection”)

Aus rechnerischen Gründen kann die beste Teilmengenauswahl nicht angewendet werden, wenn die Anzahl der \(p\) Prädiktorvariablen groß ist. Die Auswahl der besten Teilmenge kann auch unter statistischen Problemen leiden, wenn \(p\) groß ist. Je größer der Suchraum ist, desto höher ist die Wahrscheinlichkeit, Modelle zu finden, die auf den Trainingsdaten gut performen, auch wenn sie möglicherweise keine Vorhersagekraft für zukünftige Daten haben. Ein enormer Suchraum kann daher zu einer Überanpassung und einer hohen Varianz der Koeffizientenschätzungen führen. Aus diesen beiden Gründen sind schrittweise Methoden, die einen weitaus eingeschränkteren Satz von Modellen untersuchen, attraktive Alternativen zur Auswahl der besten Teilmenge.

Vorwärtsauswahl

Die schrittweise Vorwärtsauswahl beginnt mit einem Modell, das keine Prädiktoren enthält und fügt dem Modell dann nacheinander Prädiktoren hinzu, bis alle Prädiktoren im Modell enthalten sind. Insbesondere wird bei jedem Schritt die Variable zum Modell hinzugefügt, die die größte zusätzliche Verbesserung der Anpassung bewirkt.

Der dreistufige Prozess der schrittweisen Vorauswahl umfasst:

Schritt 1: Bezeichne \(M_{0}\) das Nullmodell, das keine Prädiktoren enthält. Dieses Modell sagt einfach den Stichprobenmittelwert für jede Beobachtung voraus.

Schritt 2: Für \(k = 0,…, p - 1\):

  • Betrachte alle \(p - k\)- Modelle, die die Prädiktoren in \(M_{k}\) mit einem zusätzlichen Prädiktor erweitern.
  • Wähle das beste unter diesen \(p - k\)-Modellen aus und nenne es \(M_{k+1}\). Hier wird das beste Modell als das mit dem kleinsten \(RSS\) oder dem höchstes \(R^2\) definiert.

Schritt 3: Wähle aus \(M_{0},..., M_{p}\) unter Verwendung eines kreuzvalidierten Vorhersagefehlers, \(C_{p}\), \(AIC\), \(BIC\) oder dem adjustierten \(R^2\) ein einzelnes bestes Modell aus.

Die schrittweise Vorwärtsauswahl kann mit regsubsets durchgeführt werden, indem die method = "forward" gesetzt wird:

Schrittweise rückwärts (Backward stepwise)

Die schrittweise Rückwärtsauswahl bietet eine effiziente Alternative zur Auswahl der besten Teilmenge. Im Gegensatz zur schrittweisen Vorwärtsauswahl beginnt sie jedoch mit dem vollständigen Modell der kleinsten Quadrate, das alle \(p\) Prädiktoren enthält, und entfernt dann nacheinander iterativ den am wenigsten nützlichen Prädiktor.

Der dreistufige Prozess der schrittweisen Vorauswahl umfasst:

Schritt 1: Bezeichne \(M_p\) das vollständige Modell, das alle p Prädiktoren enthält.

Schritt 2: Für \(k = p, p - 1,..., 1\)

  • Betrachte alle \(k\) Modelle, die alle bis auf einen der Prädiktoren in \(M_{k}\) enthalten für insgesamt \(k - 1\) Prädiktoren.

  • Wähle das beste unter den \(k\) Modellen aus und nenne es \(M_{k-1}\). Hier wird das beste Modell als das mit den kleinsten \(RSS\) oder den höchsten \(R^2\) definiert.

Schritt 3: Wähle aus \(M_{0},…, M_{p}\) ein einzelnes bestes Modell aus unter Verwendung eines kreuzvalidierten Vorhersagefehlers, \(C_{p}\), \(AIC\), \(BIC\) oder adjustiertem \(R^2\).

Die schrittweise Vorwärtsauswahl kann mit regsubsets durchgeführt werden, indem die method = "backward" gesetzt wird:

Modellauswahl

Bisher wurde gezeigt, wie die besten Teilmengen (Best Subset Selection) und schrittweisen Verfahren ausgeführt werden. In einem nächsten Schritt wird nun betrachtet, wie alle Modelle verglichen werden können, um das beste Modell zu ermitteln.

Um das beste Modell in Bezug auf den Testfehler auszuwählen, müssen wir diesen Testfehler schätzen. Es gibt zwei gängige Ansätze:

  • Der Testfehler kann indirekt geschätzt werden, indem der Trainingsfehler angepasst wird, um die Verzerrung aufgrund von Überanpassung (Overfitting) zu berücksichtigen.
  • Der Testfehler kann direkt abgeschätzt werden, indem entweder ein Validierungssatzansatz oder einen Kreuzvalidierungsansatz verwendet wird.

Wir betrachten im Folgenden beide Ansätze.

Indirekte Schätzung des Testfehlers mit \(C_{p}\), \(AIC\), \(BIC\) und adjustiertem \(R^2\)

Bei der Durchführung der Ansätze “beste Teilmenge” oder schrittweisen Annäherung werden die ausgewählten Modelle \(M_0,…, M_p\) basierend auf der Tatsache ausgewählt, dass sie den mittleren quadratischen Fehler (MSE) des Trainingssatzes minimieren. Aus diesem Grund und aufgrund der Tatsache, dass die Verwendung der Trainings-\(MSE\) und \(R^2\) unsere Ergebnisse beeinflusst, sollten wir diese Statistiken nicht verwenden, um zu bestimmen, welche der \(M_0,…, M_p\) Modelle “das Beste” ist.

Es stehen jedoch eine Reihe von Techniken zum Anpassen des Trainingsfehlers an die Modellgröße zur Verfügung. Diese Ansätze können verwendet werden, um aus einer Reihe von Modellen mit unterschiedlicher Anzahl von Variablen auszuwählen. Diese beinhalten:

Dabei ist \(d\) die Anzahl der Prädiktoren und \(\sigma^2\) eine Schätzung der Varianz des Fehlers (\(\epsilon\))) mit jeder Antwortmessung in einem Regressionsmodell verbunden. Jede dieser Statistiken fügt dem Trainings-\(RSS\) eine Strafe hinzu, um die Tatsache auszugleichen, dass der Trainingsfehler dazu neigt, den Testfehler zu unterschätzen. Die Strafe steigt eindeutig mit zunehmender Anzahl von Prädiktoren im Modell.

Daher liefern diese Statistiken eine unvoreingenommene Schätzung der Test-MSE. Wenn wir unser Modell unter Verwendung eines Trainings- / Testvalidierungsansatzes durchführen, können wir diese Statistiken verwenden, um das bevorzugte Modell zu bestimmen. Diese Statistiken sind in der Ausgabe der Funktion regsubsets enthalten.

Im Folgenden werden diese Informationen extrahiert und aufgezeichnet.

## [1] 30
## [1] 21
## [1] 27

Es ist erkennbar, dass die Ergebnisse leicht unterschiedliche Modelle identifizieren, die als die besten angesehen werden. Die ajustierte \(R^2\)-Statistik legt nahe, dass das 30-Variablen-Modell bevorzugt wird, die \(BIC\)-Statistik schlägt das 21-Variablenmodell vor und der \(C_{p}\) das 27-Variablen-Modell vor.

Die Variablen und Koeffizienten, die diese Modelle enthalten, können mittels der coef-Funktion verglichen werden:

##           (Intercept)           KielerWoche Wochentag_cDonnerstag 
##            108.888732             14.620447             19.776807 
##    Wochentag_cFreitag     Wochentag_cMontag    Wochentag_cSamstag 
##             12.122001             15.949012             26.166057 
##    Wochentag_cSonntag        Monat_cFebruar         Monat_cJanuar 
##            -40.029008            -13.269996            -14.219094 
##        Monat_cOktober      Monat_cSeptember        SommerferienSH 
##             17.164916              8.799025             14.631170 
##       SommerferienNRW       SommerferienNDS              Feiertag 
##             11.960519              8.995801            122.763316 
##                Ostern    ChristiHimmelfahrt             Pfingsten 
##           -319.204961           -184.568855           -167.813622 
##                   TDE            Ostern_ext         Pfingsten_ext 
##           -187.373875            173.702911             29.101572 
##      JahreszeitHerbst 
##            -12.768112

Die 21 Variablen die in das Modell mit einbezogen werden würden, sind die folgenden:

  • KielerWoche
  • Wochentag_cDonnerstag
  • Wochentag_cFreitag
  • Wochentag_cMontag
  • Wochentag_cSamstag
  • Wochentag_cSonntag
  • Monat_cFebruar
  • Monat_cJanuar
  • Monat_cOktober
  • Monat_cSeptember
  • SommerferienSH
  • SommerferienNRW
  • SommerferienNDS
  • Feiertag
  • Ostern
  • ChristiHimmelfahrt
  • Pfingsten
  • TDE
  • Ostern_ext
  • Pfingsten_ext
  • JahreszeitHerbst
##            (Intercept)            KielerWoche  Wochentag_cDonnerstag 
##             109.979243              22.711772              19.764702 
##     Wochentag_cFreitag      Wochentag_cMontag     Wochentag_cSamstag 
##              11.864151              16.294480              25.966181 
##     Wochentag_cSonntag        Monat_cDezember         Monat_cFebruar 
##             -39.964915              14.067631             -14.356062 
##          Monat_cJanuar            Monat_cMärz        Monat_cNovember 
##             -15.298812              -5.608354              13.570493 
##         Monat_cOktober       Monat_cSeptember         SommerferienSH 
##              30.889733              22.187302              16.448257 
##        SommerferienNRW        SommerferienNDS         SommerferienHE 
##              18.744751              13.725594               6.280986 
##               Feiertag                 Ostern     ChristiHimmelfahrt 
##             107.654470            -303.677882            -184.488650 
##              Pfingsten                    TDE             Ostern_ext 
##            -153.009495            -172.330009             173.858839 
## ChristiHimmelfahrt_ext          Pfingsten_ext       JahreszeitHerbst 
##              13.950236              28.111000             -27.566990 
##       JahreszeitSommer 
##             -15.008407

Das 27-Variablen-Modell gemäß best subset selection liefert folgendes Ergebnis:

  • KielerWoche
  • Wochentag_cDonnerstag
  • Wochentag_cFreitag
  • Wochentag_cMontag
  • Wochentag_cSamstag
  • Wochentag_cSonntag
  • Monat_cDezember
  • Monat_cFebruar
  • Monat_cJanuar
  • Monat_cMärz
  • Monat_cNovember
  • Monat_cOktober
  • Monat_cSeptember
  • SommerferienSH
  • SommerferienNRW
  • SommerferienNDS
  • SommerferienHE
  • Feiertag
  • Ostern
  • ChristiHimmelfahrt
  • Pfingsten
  • TDE
  • Ostern_ext
  • ChristiHimmelfahrt_ext
  • Pfingsten_ext
  • JahreszeitHerbst
  • JahreszeitSommer
##            (Intercept)            KielerWoche             Bewoelkung 
##            119.1231442             23.7174805             -0.5196306 
##             Temperatur  Wochentag_cDonnerstag     Wochentag_cFreitag 
##             -0.3759704             18.1655872             10.2453131 
##    Wochentag_cMittwoch      Wochentag_cMontag     Wochentag_cSamstag 
##             -3.3108524             14.6494272             24.3158335 
##     Wochentag_cSonntag        Monat_cDezember         Monat_cFebruar 
##            -41.7063193             11.7515546            -17.3664609 
##          Monat_cJanuar            Monat_cMärz        Monat_cNovember 
##            -18.8572469             -7.6827953             11.3302774 
##         Monat_cOktober       Monat_cSeptember         SommerferienSH 
##             30.3151309             22.2488212             16.4660783 
##        SommerferienNRW        SommerferienNDS         SommerferienHE 
##             19.1102941             14.2821906              6.4686540 
##               Feiertag                 Ostern     ChristiHimmelfahrt 
##            108.0200659           -303.2993112           -185.8569373 
##              Pfingsten                    TDE             Ostern_ext 
##           -153.4921447           -172.6591571            171.9813148 
## ChristiHimmelfahrt_ext          Pfingsten_ext       JahreszeitHerbst 
##             14.6316521             28.3177633            -27.2478868 
##       JahreszeitSommer 
##            -13.5296506

Das 30-Variablen-Modell gemäß best subset selection liefert folgendes Ergebnis:

  • KielerWoche
  • Bewoelkung
  • Temperatur
  • Wochentag_cDonnerstag
  • Wochentag_cFreitag
  • Wochentag_cMittwoch
  • Wochentag_cMontag
  • Wochentag_cSamstag
  • Wochentag_cSonntag
  • Monat_cDezember
  • Monat_cFebruar
  • Monat_cJanuar
  • Monat_cMärz
  • Monat_cNovember
  • Monat_cOktober
  • Monat_cSeptember
  • SommerferienSH
  • SommerferienNRW
  • SommerferienNDS
  • SommerferienHE
  • Feiertag
  • Ostern
  • ChristiHimmelfahrt
  • Pfingsten
  • TDE
  • Ostern_ext
  • ChristiHimmelfahrt_ext
  • Pfingsten_ext
  • JahreszeitHerbst
  • JahreszeitSommer

Der gleiche Prozess kann durch schrittweise Vorwärts- und Rückwärtsauswahl durchgeführt werden, um noch mehr Optionen für optimale Modelle zu erhalten:

## [1] 31
## [1] 27

Wenn man das optimale \(C_{p}\) für vorwärts und rückwärts schrittweise bewertet, ist erkennbar, dass gemäß der Vorwärts-Methode ein 31-Variablen-Modell die \(C_{p}\)-Statistik minimiert. Die Rückwärtsmethode schlägt ein 27-Variablen-Modell vor, ähnlich dem oben beschriebenen besten Teilmengenansatz.

Ein Vergleich des 27-Variablen-backward-Modell mit dem 27-Variablen-Modell der “best subset selection” ergibt Folgendes:

##            (Intercept)            KielerWoche  Wochentag_cDonnerstag 
##             109.979243              22.711772              19.764702 
##     Wochentag_cFreitag      Wochentag_cMontag     Wochentag_cSamstag 
##              11.864151              16.294480              25.966181 
##     Wochentag_cSonntag        Monat_cDezember         Monat_cFebruar 
##             -39.964915              14.067631             -14.356062 
##          Monat_cJanuar            Monat_cMärz        Monat_cNovember 
##             -15.298812              -5.608354              13.570493 
##         Monat_cOktober       Monat_cSeptember         SommerferienSH 
##              30.889733              22.187302              16.448257 
##        SommerferienNRW        SommerferienNDS         SommerferienHE 
##              18.744751              13.725594               6.280986 
##               Feiertag                 Ostern     ChristiHimmelfahrt 
##             107.654470            -303.677883            -184.488651 
##              Pfingsten                    TDE             Ostern_ext 
##            -153.009495            -172.330010             173.858839 
## ChristiHimmelfahrt_ext          Pfingsten_ext       JahreszeitHerbst 
##              13.950236              28.111000             -27.566990 
##       JahreszeitSommer 
##             -15.008407
  • KielerWoche
  • Wochentag_cDonnerstag
  • Wochentag_cFreitag
  • Wochentag_cMontag
  • Wochentag_cSamstag
  • Wochentag_cSonntag
  • Monat_cDezember
  • Monat_cFebruar
  • Monat_cJanuar
  • Monat_cMärz
  • Monat_cNovember
  • Monat_cOktober
  • Monat_cSeptember
  • SommerferienSH
  • SommerferienNRW
  • SommerferienNDS
  • SommerferienHE
  • Feiertag
  • Ostern
  • ChristiHimmelfahrt
  • Pfingsten
  • TDE
  • Ostern_ext
  • ChristiHimmelfahrt_ext
  • Pfingsten_ext
  • JahreszeitHerbst
  • JahreszeitSommer

Beide Verfahren schlagen dieselben Variablen für die Aufnahme in ein Regressionsmodell vor.

Betrachtet man das 31-Variablen-Modell der forward stepwise-Methode, ergibt sich folgendes Bild:

##            (Intercept)            KielerWoche             Bewoelkung 
##            119.0668487             23.5756179             -0.5189617 
##             Temperatur  Wochentag_cDonnerstag     Wochentag_cFreitag 
##             -0.3725949             18.1705826             10.1776518 
##    Wochentag_cMittwoch      Wochentag_cMontag     Wochentag_cSamstag 
##             -3.3729094             14.6368248             24.2473833 
##     Wochentag_cSonntag        Monat_cDezember         Monat_cFebruar 
##            -41.7169418             10.9075926            -17.2961926 
##          Monat_cJanuar            Monat_cMärz        Monat_cNovember 
##            -18.7815063             -7.6260992             10.6279017 
##         Monat_cOktober       Monat_cSeptember         SommerferienSH 
##             29.5982162             21.8531767             16.3919653 
##        SommerferienNRW        SommerferienNDS         SommerferienHE 
##             18.9505653             14.1327347              6.4708933 
##               Feiertag                 Ostern     ChristiHimmelfahrt 
##             99.0655548           -294.3801175           -176.9522735 
##              Pfingsten                    TDE             Ostern_ext 
##           -144.5580625           -163.7168792            172.0344487 
## ChristiHimmelfahrt_ext          Pfingsten_ext          Silvester_ext 
##             14.6799365             28.3557205              9.8577891 
##       JahreszeitHerbst       JahreszeitSommer 
##            -26.4870412            -13.2352199
  • KielerWoche
  • Bewoelkung
  • Temperatu*
  • Wochentag_cDonnerstag
  • Wochentag_cFreitag
  • Wochentag_cMittwoch
  • Wochentag_cMontag
  • Wochentag_cSamstag
  • Wochentag_cSonntag
  • Monat_cDezember
  • Monat_cFebruar
  • Monat_cJanuar
  • Monat_cMärz
  • Monat_cNovember
  • Monat_cOktober
  • Monat_cSeptember
  • SommerferienSH
  • SommerferienNRW
  • SommerferienNDS
  • SommerferienHE
  • Feiertag
  • Ostern
  • ChristiHimmelfahrt
  • Pfingsten
  • TDE
  • Ostern_ext
  • ChristiHimmelfahrt_ext
  • Pfingsten_ext
  • Silvester_ext
  • JahreszeitHerbst
  • JahreszeitSommer

Vergleicht man die Koeffizienten wiederum mit 30-Variablen-Modell der best subset selection, stimmen all Variablen überein; beim 31-Variablen-Modell wird weiterhin die Variable Silvester_ext einbezogen.

Direkte Schätzung des Testfehlers

Nun wird der Fehler der Testdaten für das beste Modell jeder Modellgröße berechnet. Zuerst wird eine Modellmatrix aus den Testdaten erstellt. Die Funktion model.matrix wird in vielen Regressionspaketen zum Erstellen einer X-Matrix aus Daten verwendet.

Jetzt kann jede Modellgröße (d.h. 1 Variable, 2 Variablen,…, 20 Variablen) durchlaufen werden und die Koeffizienten für das beste Modell dieser Größe extrahiert werden. Diese Werte werden sodann in die entsprechenden Spalten der Testmodellmatrix multipliziert, um die Vorhersagen zu bilden. Dann werden die Test-MSE berechnet.

##           [,1]
##  [1,] 1860.918
##  [2,] 1682.378
##  [3,] 1497.774
##  [4,] 1307.769
##  [5,] 1259.792
##  [6,] 1249.266
##  [7,] 1206.777
##  [8,] 1162.289
##  [9,] 1149.677
## [10,] 1142.388
## [11,] 1124.089
## [12,] 1110.791
## [13,] 1070.296
## [14,] 1069.631
## [15,] 1062.172
## [16,] 1079.990
## [17,] 1072.604
## [18,] 1087.550
## [19,] 1079.241
## [20,] 1053.798
## [21,] 1049.652
## [22,] 1095.586
## [23,] 1089.673
## [24,] 1094.242
## [25,] 1070.017
## [26,] 1083.261
## [27,] 1080.720
## [28,] 1088.128
## [29,] 1082.239
## [30,] 1078.903
## [31,] 1073.617
## [32,] 1075.004
## [33,] 1074.223
## [34,] 1076.248
## [35,] 1076.519
## [36,] 1075.426
## [37,] 1071.687

Es ist erkennbar, dass ein 21-Variablen-Modell, das durch den besten Teilmengenansatz erzeugt wird, den niedrigsten Test-MSE erzeugt.

Einzelne Modelle werden im Folgenden miteinander verglichen. Da sowohl die best subset selection als auch die backward selction u. a. zu einem 27-Variablen-Modell geführt haben, wird dieses getestet. Weiterhin wird das “größte” Modell mit 31 Variablen in den Vergleich einbezogen. Abschließend wird geprüft, wie ein schlankeres Modell mit 21 Variablen performt.

Teilmengenauswahl für das 27-Variablen-Modell gemäß best subset selection und backward selection

Die 27 Variablen gemäß best subset selection sind die folgenden:

  • KielerWoche
  • Wochentag_cDonnerstag
  • Wochentag_cFreitag
  • Wochentag_cMontag
  • Wochentag_cSamstag
  • Wochentag_cSonntag
  • Monat_cDezember
  • Monat_cFebruar
  • Monat_cJanuar
  • Monat_cMärz
  • Monat_cNovember
  • Monat_cOktober
  • Monat_cSeptember
  • SommerferienSH
  • SommerferienNRW
  • SommerferienNDS
  • SommerferienHE
  • Feiertag
  • Ostern
  • ChristiHimmelfahrt
  • Pfingsten
  • TDE
  • Ostern_ext
  • ChristiHimmelfahrt_ext
  • Pfingsten_ext
  • JahreszeitHerbst
  • JahreszeitSommer

Die Variablen Wochentag_c, Monat_c und Jahreszeit müssen nun noch dummyfiziert werden (bei Einbeziehung aller Variablen erfolgt die Dummyfizierung automatisch im Rahmen der Regressionsanalyse): Für jeden Wochentag wird eine Variable mit Ausprägung 0/1 gebildet und danach die alte Variable Wochentag_c entfernt. Analog wird bei den beiden anderen Variablen vorgegangen.

# Dummyfizierung der Variablen im Trainigsdatensatz:
df_lm_train_WG1_27 <- df_lm_train_WG1 %>%
  mutate(Montag=as.integer(df_lm_train_WG1$Wochentag_c=="Montag")) %>%
  mutate(Dienstag=as.integer(df_lm_train_WG1$Wochentag_c=="Dienstag")) %>%
  mutate(Mittwoch=as.integer(df_lm_train_WG1$Wochentag_c=="Mittwoch")) %>%
  mutate(Donnerstag=as.integer(df_lm_train_WG1$Wochentag_c=="Donnerstag")) %>%
  mutate(Freitag=as.integer(df_lm_train_WG1$Wochentag_c=="Freitag")) %>%
  mutate(Samstag=as.integer(df_lm_train_WG1$Wochentag_c=="Samstag")) %>%
  mutate(Sonntag=as.integer(df_lm_train_WG1$Wochentag_c=="Sonntag")) %>%
  mutate(Januar=as.integer(df_lm_train_WG1$Monat_c=="Januar")) %>%
  mutate(Februar=as.integer(df_lm_train_WG1$Monat_c=="Februar")) %>%
  mutate(Maerz=as.integer(df_lm_train_WG1$Monat_c=="Maerz")) %>%
  mutate(April=as.integer(df_lm_train_WG1$Monat_c=="April")) %>%
  mutate(Mai=as.integer(df_lm_train_WG1$Monat_c=="Mai")) %>%
  mutate(Juni=as.integer(df_lm_train_WG1$Monat_c=="Juni")) %>%
  mutate(Juli=as.integer(df_lm_train_WG1$Monat_c=="Juli")) %>%
  mutate(August=as.integer(df_lm_train_WG1$Monat_c=="August")) %>%
  mutate(September=as.integer(df_lm_train_WG1$Monat_c=="September")) %>%
  mutate(Oktober=as.integer(df_lm_train_WG1$Monat_c=="Oktober")) %>%
  mutate(November=as.integer(df_lm_train_WG1$Monat_c=="November")) %>%
  mutate(Dezember=as.integer(df_lm_train_WG1$Monat_c=="Dezember")) %>%
  mutate(Fruehling=as.integer(df_lm_train_WG1$Jahreszeit=="Fruehling")) %>%
  mutate(Sommer=as.integer(df_lm_train_WG1$Jahreszeit=="Sommer")) %>%
  mutate(Herbst=as.integer(df_lm_train_WG1$Jahreszeit=="Herbst")) %>%
  mutate(Winter=as.integer(df_lm_train_WG1$Jahreszeit=="Winter")) %>%
  dplyr::select(-Wochentag_c, -Monat_c, -Jahreszeit)

df_lm_test_WG1_27 <- df_lm_test_WG1 %>%
  mutate(Montag=as.integer(df_lm_test_WG1$Wochentag_c=="Montag")) %>%
  mutate(Dienstag=as.integer(df_lm_test_WG1$Wochentag_c=="Dienstag")) %>%
  mutate(Mittwoch=as.integer(df_lm_test_WG1$Wochentag_c=="Mittwoch")) %>%
  mutate(Donnerstag=as.integer(df_lm_test_WG1$Wochentag_c=="Donnerstag")) %>%
  mutate(Freitag=as.integer(df_lm_test_WG1$Wochentag_c=="Freitag")) %>%
  mutate(Samstag=as.integer(df_lm_test_WG1$Wochentag_c=="Samstag")) %>%
  mutate(Sonntag=as.integer(df_lm_test_WG1$Wochentag_c=="Sonntag")) %>%
  mutate(Januar=as.integer(df_lm_test_WG1$Monat_c=="Januar")) %>%
  mutate(Februar=as.integer(df_lm_test_WG1$Monat_c=="Februar")) %>%
  mutate(Maerz=as.integer(df_lm_test_WG1$Monat_c=="Maerz")) %>%
  mutate(April=as.integer(df_lm_test_WG1$Monat_c=="April")) %>%
  mutate(Mai=as.integer(df_lm_test_WG1$Monat_c=="Mai")) %>%
  mutate(Juni=as.integer(df_lm_test_WG1$Monat_c=="Juni")) %>%
  mutate(Juli=as.integer(df_lm_test_WG1$Monat_c=="Juli")) %>%
  mutate(August=as.integer(df_lm_test_WG1$Monat_c=="August")) %>%
  mutate(September=as.integer(df_lm_test_WG1$Monat_c=="September")) %>%
  mutate(Oktober=as.integer(df_lm_test_WG1$Monat_c=="Oktober")) %>%
  mutate(November=as.integer(df_lm_test_WG1$Monat_c=="November")) %>%
  mutate(Dezember=as.integer(df_lm_test_WG1$Monat_c=="Dezember")) %>%
  mutate(Fruehling=as.integer(df_lm_test_WG1$Jahreszeit=="Fruehling")) %>%
  mutate(Sommer=as.integer(df_lm_test_WG1$Jahreszeit=="Sommer")) %>%
  mutate(Herbst=as.integer(df_lm_test_WG1$Jahreszeit=="Herbst")) %>%
  mutate(Winter=as.integer(df_lm_test_WG1$Jahreszeit=="Winter")) %>%
  dplyr::select(-Wochentag_c, -Monat_c, -Jahreszeit)

Für das 27-Variablenmodell der best subset selection wird nun ein Regressionsmodell erstellt:

## # A tibble: 1 x 11
##   r.squared adj.r.squared sigma statistic   p.value    df logLik   AIC
##       <dbl>         <dbl> <dbl>     <dbl>     <dbl> <int>  <dbl> <dbl>
## 1     0.577         0.567  25.3      54.3 5.40e-173    27 -4919. 9894.
## # ... with 3 more variables: BIC <dbl>, deviance <dbl>, df.residual <int>

Dann wird (die Modellgüte) anhand der Test-Stichprobe getestet:

## Warning in predict.lm(lm_WG1_27_train, newdata = df_lm_test_WG1_27):
## prediction from a rank-deficient fit may be misleading

Als Ergebnis wird ein Vektor erzeugt, der für jede Beobachtung des Test-Samples den geschätzten (vorhergesagten) Umsatzwert speichert. Die Gütewerte lassen sich mit caret::postResample ausgeben:

##       RMSE   Rsquared        MAE 
## 32.6708972  0.5834043 24.8277040

Diese Vorhersage-Ergebnisse werden den Test-Daten hinzugefügt und sodann eine gemeinsame Übersichtstabelle für die Gütekennzahlen angelegt lm_vgl_kennz, die nach und nach angereichert wird mit den Ergebnissen der anderen Modelle je Warengruppe:

# Hinzufügen der Ergebnisse
df_lm_test_WG1_27 <- df_lm_test_WG1_27 %>%
  mutate(predicted = lm_WG1_27_predict)

# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
df_lm_test_WG1_27 <- df_lm_test_WG1_27 %>%
  mutate(Prognose_zuhoch = (predicted >= Umsatz)) %>%
  mutate(Abweichung = predicted - Umsatz) %>%
  mutate(Abweichung_abs = abs(predicted - Umsatz)) %>%
  mutate(Abweichung_rel = (predicted - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Ergänze die benötigten Hilfsgrößen
df_lm_test_WG1_27 <-df_lm_test_WG1_27 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- df_lm_test_WG1_27 %>%
  group_by() %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz), 2), Umsatz_mittel = round(sum(Umsatz)/n(), 2), MAE = round(mean(Abweichung_abs), 2), MPE = round(mean(Abweichung_rel)*100, 2), MAPE = round(mean(Abweichung_rel_abs)*100, 2), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100, 2), MSE = round(mean(Abweichung_quad), 2), RMSE = round(sqrt(mean(Abweichung_quad)), 2), rRMSE = round(RMSE/Umsatz_mittel*100, 2))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "best27_WG1")

# füge die Kennzahlen nun an die Vergleichstabelle
lm_vgl_kennz <- temp
lm_vgl_kennz %>%
  arrange(WAPE)
## # A tibble: 1 x 11
##   Anzahl Umsatz_ges Umsatz_mittel   MAE   MPE  MAPE  WAPE   MSE  RMSE rRMSE
##    <int>      <dbl>         <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1    346     45738.          132.  24.8 -7.84  18.7  18.8 1067.  32.7  24.7
## # ... with 1 more variable: Modell <chr>

Teilmengenauswahl für das 31-Variablen-Modell gemäß backward stepwise

Es erfolgt ein weiterer Vergleich mit dem 31 Variablen-Modell der best subset selection:

Die 31 Variablen gemäß best subset selection sind die folgenden:

  • KielerWoche
  • Bewoelkung
  • Temperatu*
  • Wochentag_cDonnerstag
  • Wochentag_cFreitag
  • Wochentag_cMittwoch
  • Wochentag_cMontag
  • Wochentag_cSamstag
  • Wochentag_cSonntag
  • Monat_cDezember
  • Monat_cFebruar
  • Monat_cJanuar
  • Monat_cMärz
  • Monat_cNovember
  • Monat_cOktober
  • Monat_cSeptember
  • SommerferienSH
  • SommerferienNRW
  • SommerferienNDS
  • SommerferienHE
  • Feiertag
  • Ostern
  • ChristiHimmelfahrt
  • Pfingsten
  • TDE
  • Ostern_ext
  • ChristiHimmelfahrt_ext
  • Pfingsten_ext
  • Silvester_ext
  • JahreszeitHerbst
  • JahreszeitSommer

Die Variablen Wochentag_c, Monat_c und Jahreszeit müssen nun noch dummyfiziert werden (bei Einbeziehung aller Variablen erfolgt die Dummyfizierung automatisch im Rahmen der Regressionsanalyse): Für jeden Wochentag wird eine Variable mit Ausprägung 0/1 gebildet und danach die alte Variable Wochentag_c entfernt. Analog wird bei den beiden anderen Variablen vorgegangen.

# Dummyfizierung der Variablen im Trainigsdatensatz:
df_lm_train_WG1_31 <- df_lm_train_WG1 %>%
  mutate(Montag=as.integer(df_lm_train_WG1$Wochentag_c=="Montag")) %>%
  mutate(Dienstag=as.integer(df_lm_train_WG1$Wochentag_c=="Dienstag")) %>%
  mutate(Mittwoch=as.integer(df_lm_train_WG1$Wochentag_c=="Mittwoch")) %>%
  mutate(Donnerstag=as.integer(df_lm_train_WG1$Wochentag_c=="Donnerstag")) %>%
  mutate(Freitag=as.integer(df_lm_train_WG1$Wochentag_c=="Freitag")) %>%
  mutate(Samstag=as.integer(df_lm_train_WG1$Wochentag_c=="Samstag")) %>%
  mutate(Sonntag=as.integer(df_lm_train_WG1$Wochentag_c=="Sonntag")) %>%
  mutate(Januar=as.integer(df_lm_train_WG1$Monat_c=="Januar")) %>%
  mutate(Februar=as.integer(df_lm_train_WG1$Monat_c=="Februar")) %>%
  mutate(Maerz=as.integer(df_lm_train_WG1$Monat_c=="Maerz")) %>%
  mutate(April=as.integer(df_lm_train_WG1$Monat_c=="April")) %>%
  mutate(Mai=as.integer(df_lm_train_WG1$Monat_c=="Mai")) %>%
  mutate(Juni=as.integer(df_lm_train_WG1$Monat_c=="Juni")) %>%
  mutate(Juli=as.integer(df_lm_train_WG1$Monat_c=="Juli")) %>%
  mutate(August=as.integer(df_lm_train_WG1$Monat_c=="August")) %>%
  mutate(September=as.integer(df_lm_train_WG1$Monat_c=="September")) %>%
  mutate(Oktober=as.integer(df_lm_train_WG1$Monat_c=="Oktober")) %>%
  mutate(November=as.integer(df_lm_train_WG1$Monat_c=="November")) %>%
  mutate(Dezember=as.integer(df_lm_train_WG1$Monat_c=="Dezember")) %>%
  mutate(Fruehling=as.integer(df_lm_train_WG1$Jahreszeit=="Fruehling")) %>%
  mutate(Sommer=as.integer(df_lm_train_WG1$Jahreszeit=="Sommer")) %>%
  mutate(Herbst=as.integer(df_lm_train_WG1$Jahreszeit=="Herbst")) %>%
  mutate(Winter=as.integer(df_lm_train_WG1$Jahreszeit=="Winter")) %>%
  dplyr::select(-Wochentag_c, -Monat_c, -Jahreszeit)

df_lm_test_WG1_31 <- df_lm_test_WG1 %>%
  mutate(Montag=as.integer(df_lm_test_WG1$Wochentag_c=="Montag")) %>%
  mutate(Dienstag=as.integer(df_lm_test_WG1$Wochentag_c=="Dienstag")) %>%
  mutate(Mittwoch=as.integer(df_lm_test_WG1$Wochentag_c=="Mittwoch")) %>%
  mutate(Donnerstag=as.integer(df_lm_test_WG1$Wochentag_c=="Donnerstag")) %>%
  mutate(Freitag=as.integer(df_lm_test_WG1$Wochentag_c=="Freitag")) %>%
  mutate(Samstag=as.integer(df_lm_test_WG1$Wochentag_c=="Samstag")) %>%
  mutate(Sonntag=as.integer(df_lm_test_WG1$Wochentag_c=="Sonntag")) %>%
  mutate(Januar=as.integer(df_lm_test_WG1$Monat_c=="Januar")) %>%
  mutate(Februar=as.integer(df_lm_test_WG1$Monat_c=="Februar")) %>%
  mutate(Maerz=as.integer(df_lm_test_WG1$Monat_c=="Maerz")) %>%
  mutate(April=as.integer(df_lm_test_WG1$Monat_c=="April")) %>%
  mutate(Mai=as.integer(df_lm_test_WG1$Monat_c=="Mai")) %>%
  mutate(Juni=as.integer(df_lm_test_WG1$Monat_c=="Juni")) %>%
  mutate(Juli=as.integer(df_lm_test_WG1$Monat_c=="Juli")) %>%
  mutate(August=as.integer(df_lm_test_WG1$Monat_c=="August")) %>%
  mutate(September=as.integer(df_lm_test_WG1$Monat_c=="September")) %>%
  mutate(Oktober=as.integer(df_lm_test_WG1$Monat_c=="Oktober")) %>%
  mutate(November=as.integer(df_lm_test_WG1$Monat_c=="November")) %>%
  mutate(Dezember=as.integer(df_lm_test_WG1$Monat_c=="Dezember")) %>%
  mutate(Fruehling=as.integer(df_lm_test_WG1$Jahreszeit=="Fruehling")) %>%
  mutate(Sommer=as.integer(df_lm_test_WG1$Jahreszeit=="Sommer")) %>%
  mutate(Herbst=as.integer(df_lm_test_WG1$Jahreszeit=="Herbst")) %>%
  mutate(Winter=as.integer(df_lm_test_WG1$Jahreszeit=="Winter")) %>%
  dplyr::select(-Wochentag_c, -Monat_c, -Jahreszeit)

Für das 31-Variablenmodell der best subset selection wird nun ein Regressionsmodell erstellt:

## # A tibble: 1 x 11
##   r.squared adj.r.squared sigma statistic   p.value    df logLik   AIC
##       <dbl>         <dbl> <dbl>     <dbl>     <dbl> <int>  <dbl> <dbl>
## 1     0.579         0.567  25.3      47.2 2.38e-170    31 -4917. 9898.
## # ... with 3 more variables: BIC <dbl>, deviance <dbl>, df.residual <int>

Dann wird (die Modellgüte) anhand der Test-Stichprobe getestet:

## Warning in predict.lm(lm_WG1_31_train, newdata = df_lm_test_WG1_31):
## prediction from a rank-deficient fit may be misleading

Als Ergebnis wird ein Vektor erzeugt, der für jede Beobachtung des Test-Samples den geschätzten (vorhergesagten) Umsatzwert speichert. Die Gütewerte lassen sich mit caret::postResample ausgeben:

##       RMSE   Rsquared        MAE 
## 32.6212367  0.5816673 24.8093885

Diese Vorhersage-Ergebnisse werden den Test-Daten hinzugefügt und sodann eine gemeinsame Übersichtstabelle für die Gütekennzahlen angelegt lm_vgl_kennz, die nach und nach angereichert wird mit den Ergebnissen der anderen Modelle je Warengruppe:

# Hinzufügen der Ergebnisse
df_lm_test_WG1_31 <- df_lm_test_WG1_31 %>%
  mutate(predicted = lm_WG1_31_predict)

# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
df_lm_test_WG1_31 <- df_lm_test_WG1_31 %>%
  mutate(Prognose_zuhoch = (predicted >= Umsatz)) %>%
  mutate(Abweichung = predicted - Umsatz) %>%
  mutate(Abweichung_abs = abs(predicted - Umsatz)) %>%
  mutate(Abweichung_rel = (predicted - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Ergänze die benötigten Hilfsgrößen
df_lm_test_WG1_31 <-df_lm_test_WG1_31 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- df_lm_test_WG1_31 %>%
  group_by() %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz), 2), Umsatz_mittel = round(sum(Umsatz)/n(), 2), MAE = round(mean(Abweichung_abs), 2), MPE = round(mean(Abweichung_rel)*100, 2), MAPE = round(mean(Abweichung_rel_abs)*100, 2), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100, 2), MSE = round(mean(Abweichung_quad), 2), RMSE = round(sqrt(mean(Abweichung_quad)), 2), rRMSE = round(RMSE/Umsatz_mittel*100, 2))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "best31_WG1")

# füge die Kennzahlen nun an die Vergleichstabelle
lm_vgl_kennz <- rbind(lm_vgl_kennz, temp)
lm_vgl_kennz %>%
  arrange(desc(WAPE))
## # A tibble: 2 x 11
##   Anzahl Umsatz_ges Umsatz_mittel   MAE   MPE  MAPE  WAPE   MSE  RMSE rRMSE
##    <int>      <dbl>         <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1    346     45738.          132.  24.8 -7.84  18.7  18.8 1067.  32.7  24.7
## 2    346     45738.          132.  24.8 -7.65  18.8  18.8 1064.  32.6  24.7
## # ... with 1 more variable: Modell <chr>

Teilmengenauswahl für das 21-Variablen-Modell gemäß backward stepwise

Es erfolgt ein weiterer Vergleich mit dem 21 Variablen-Modell der best subset selection:

Die 21 Variablen gemäß best subset selection sind die folgenden:

  • KielerWoche
  • Wochentag_cDonnerstag
  • Wochentag_cFreitag
  • Wochentag_cMontag
  • Wochentag_cSamstag
  • Wochentag_cSonntag
  • Monat_cFebruar
  • Monat_cJanuar
  • Monat_cOktober
  • Monat_cSeptember
  • SommerferienSH
  • SommerferienNRW
  • SommerferienNDS
  • Feiertag
  • Ostern
  • ChristiHimmelfahrt
  • Pfingsten
  • TDE
  • Ostern_ext
  • Pfingsten_ext
  • JahreszeitHerbst

Die Variablen Wochentag_c, Monat_c und Jahreszeit müssen nun noch dummyfiziert werden (bei Einbeziehung aller Variablen erfolgt die Dummyfizierung automatisch im Rahmen der Regressionsanalyse): Für jeden Wochentag wird eine Variable mit Ausprägung 0/1 gebildet und danach die alte Variable Wochentag_c entfernt. Analog wird bei den beiden anderen Variablen vorgegangen.

# Dummyfizierung der Variablen im Trainigsdatensatz:
df_lm_train_WG1_21 <- df_lm_train_WG1 %>%
  mutate(Montag=as.integer(df_lm_train_WG1$Wochentag_c=="Montag")) %>%
  mutate(Dienstag=as.integer(df_lm_train_WG1$Wochentag_c=="Dienstag")) %>%
  mutate(Mittwoch=as.integer(df_lm_train_WG1$Wochentag_c=="Mittwoch")) %>%
  mutate(Donnerstag=as.integer(df_lm_train_WG1$Wochentag_c=="Donnerstag")) %>%
  mutate(Freitag=as.integer(df_lm_train_WG1$Wochentag_c=="Freitag")) %>%
  mutate(Samstag=as.integer(df_lm_train_WG1$Wochentag_c=="Samstag")) %>%
  mutate(Sonntag=as.integer(df_lm_train_WG1$Wochentag_c=="Sonntag")) %>%
  mutate(Januar=as.integer(df_lm_train_WG1$Monat_c=="Januar")) %>%
  mutate(Februar=as.integer(df_lm_train_WG1$Monat_c=="Februar")) %>%
  mutate(Maerz=as.integer(df_lm_train_WG1$Monat_c=="Maerz")) %>%
  mutate(April=as.integer(df_lm_train_WG1$Monat_c=="April")) %>%
  mutate(Mai=as.integer(df_lm_train_WG1$Monat_c=="Mai")) %>%
  mutate(Juni=as.integer(df_lm_train_WG1$Monat_c=="Juni")) %>%
  mutate(Juli=as.integer(df_lm_train_WG1$Monat_c=="Juli")) %>%
  mutate(August=as.integer(df_lm_train_WG1$Monat_c=="August")) %>%
  mutate(September=as.integer(df_lm_train_WG1$Monat_c=="September")) %>%
  mutate(Oktober=as.integer(df_lm_train_WG1$Monat_c=="Oktober")) %>%
  mutate(November=as.integer(df_lm_train_WG1$Monat_c=="November")) %>%
  mutate(Dezember=as.integer(df_lm_train_WG1$Monat_c=="Dezember")) %>%
  mutate(Fruehling=as.integer(df_lm_train_WG1$Jahreszeit=="Fruehling")) %>%
  mutate(Sommer=as.integer(df_lm_train_WG1$Jahreszeit=="Sommer")) %>%
  mutate(Herbst=as.integer(df_lm_train_WG1$Jahreszeit=="Herbst")) %>%
  mutate(Winter=as.integer(df_lm_train_WG1$Jahreszeit=="Winter")) %>%
  dplyr::select(-Wochentag_c, -Monat_c, -Jahreszeit)

df_lm_test_WG1_21 <- df_lm_test_WG1 %>%
  mutate(Montag=as.integer(df_lm_test_WG1$Wochentag_c=="Montag")) %>%
  mutate(Dienstag=as.integer(df_lm_test_WG1$Wochentag_c=="Dienstag")) %>%
  mutate(Mittwoch=as.integer(df_lm_test_WG1$Wochentag_c=="Mittwoch")) %>%
  mutate(Donnerstag=as.integer(df_lm_test_WG1$Wochentag_c=="Donnerstag")) %>%
  mutate(Freitag=as.integer(df_lm_test_WG1$Wochentag_c=="Freitag")) %>%
  mutate(Samstag=as.integer(df_lm_test_WG1$Wochentag_c=="Samstag")) %>%
  mutate(Sonntag=as.integer(df_lm_test_WG1$Wochentag_c=="Sonntag")) %>%
  mutate(Januar=as.integer(df_lm_test_WG1$Monat_c=="Januar")) %>%
  mutate(Februar=as.integer(df_lm_test_WG1$Monat_c=="Februar")) %>%
  mutate(Maerz=as.integer(df_lm_test_WG1$Monat_c=="Maerz")) %>%
  mutate(April=as.integer(df_lm_test_WG1$Monat_c=="April")) %>%
  mutate(Mai=as.integer(df_lm_test_WG1$Monat_c=="Mai")) %>%
  mutate(Juni=as.integer(df_lm_test_WG1$Monat_c=="Juni")) %>%
  mutate(Juli=as.integer(df_lm_test_WG1$Monat_c=="Juli")) %>%
  mutate(August=as.integer(df_lm_test_WG1$Monat_c=="August")) %>%
  mutate(September=as.integer(df_lm_test_WG1$Monat_c=="September")) %>%
  mutate(Oktober=as.integer(df_lm_test_WG1$Monat_c=="Oktober")) %>%
  mutate(November=as.integer(df_lm_test_WG1$Monat_c=="November")) %>%
  mutate(Dezember=as.integer(df_lm_test_WG1$Monat_c=="Dezember")) %>%
  mutate(Fruehling=as.integer(df_lm_test_WG1$Jahreszeit=="Fruehling")) %>%
  mutate(Sommer=as.integer(df_lm_test_WG1$Jahreszeit=="Sommer")) %>%
  mutate(Herbst=as.integer(df_lm_test_WG1$Jahreszeit=="Herbst")) %>%
  mutate(Winter=as.integer(df_lm_test_WG1$Jahreszeit=="Winter")) %>%
  dplyr::select(-Wochentag_c, -Monat_c, -Jahreszeit)

Für das 21-Variablenmodell der best subset selection wird nun ein Regressionsmodell erstellt:

## # A tibble: 1 x 11
##   r.squared adj.r.squared sigma statistic   p.value    df logLik   AIC
##       <dbl>         <dbl> <dbl>     <dbl>     <dbl> <int>  <dbl> <dbl>
## 1     0.567         0.559  25.5      64.9 2.44e-172    22 -4931. 9908.
## # ... with 3 more variables: BIC <dbl>, deviance <dbl>, df.residual <int>

Dann wird (die Modellgüte) anhand der Test-Stichprobe getestet:

Als Ergebnis wird ein Vektor erzeugt, der für jede Beobachtung des Test-Samples den geschätzten (vorhergesagten) Umsatzwert speichert. Die Gütewerte lassen sich mit caret::postResample ausgeben:

##       RMSE   Rsquared        MAE 
## 32.3983349  0.5953173 24.7343684

Diese Vorhersage-Ergebnisse werden den Test-Daten hinzugefügt und sodann eine gemeinsame Übersichtstabelle für die Gütekennzahlen angelegt lm_vgl_kennz, die nach und nach angereichert wird mit den Ergebnissen der anderen Modelle je Warengruppe:

# Hinzufügen der Ergebnisse
df_lm_test_WG1_21 <- df_lm_test_WG1_21 %>%
  mutate(predicted = lm_WG1_21_predict)

# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
df_lm_test_WG1_21 <- df_lm_test_WG1_21 %>%
  mutate(Prognose_zuhoch = (predicted >= Umsatz)) %>%
  mutate(Abweichung = predicted - Umsatz) %>%
  mutate(Abweichung_abs = abs(predicted - Umsatz)) %>%
  mutate(Abweichung_rel = (predicted - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Ergänze die benötigten Hilfsgrößen
df_lm_test_WG1_21 <-df_lm_test_WG1_21 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- df_lm_test_WG1_21 %>%
  group_by() %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz), 2), Umsatz_mittel = round(sum(Umsatz)/n(), 2), MAE = round(mean(Abweichung_abs), 2), MPE = round(mean(Abweichung_rel)*100, 2), MAPE = round(mean(Abweichung_rel_abs)*100, 2), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100, 2), MSE = round(mean(Abweichung_quad), 2), RMSE = round(sqrt(mean(Abweichung_quad)), 2), rRMSE = round(RMSE/Umsatz_mittel*100, 2))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "best21_WG1")

# füge die Kennzahlen nun an die Vergleichstabelle
lm_vgl_kennz <- rbind(lm_vgl_kennz, temp)
lm_vgl_kennz %>%
  arrange(WAPE)
## # A tibble: 3 x 11
##   Anzahl Umsatz_ges Umsatz_mittel   MAE   MPE  MAPE  WAPE   MSE  RMSE rRMSE
##    <int>      <dbl>         <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1    346     45738.          132.  24.7 -7.93  18.5  18.7 1050.  32.4  24.5
## 2    346     45738.          132.  24.8 -7.65  18.8  18.8 1064.  32.6  24.7
## 3    346     45738.          132.  24.8 -7.84  18.7  18.8 1067.  32.7  24.7
## # ... with 1 more variable: Modell <chr>

Der Vergleich der Modelle zeigt, dass es keine großen Unterschiede bei den Gütekennzahlen gibt. Die 10 Variablen mehr, die im 31-Variablen-Modell gegenüber dem 21-Variablen-Modell hinzugefügt werden, scheinen keinen wirklich relevanten weiteren Prognosebeitrag zu liefern. Das schlanke Modell performt sogar am besten, wenn auch nur marginal. Da generell schlankere Modelle bevorzugt werden sollten, würde die Wahl hier auf das 21-Variablen-Modell fallen.

Für das 21-Variablen-Modell wird nun noch geprüft, ob das Hinzufügen von Interaktionseffekten eine Verbesserung bewirkt. Es könnte ja bspw. sein, dassdie Stärke des Einflusses der Kieler Woche am Wochenende anders ist als an den Wochentagen. Am Samstag und Sonntag, so könnte man argumentieren, besuchen mehr Gäste von außerhalb, also Menschen, die nicht in Kiel wohnen, die Kieler Woche, da sie nicht arbeiten müssen, mehr Zeit haben etc.

Um R dazu zu bringen, die Regressionsgerade frei variieren zu lassen, werden die Interaktionen als zusätzliche Terme zur Regressionsgeraden hinzugefügt:

## # A tibble: 1 x 11
##   r.squared adj.r.squared sigma statistic   p.value    df logLik   AIC
##       <dbl>         <dbl> <dbl>     <dbl>     <dbl> <int>  <dbl> <dbl>
## 1     0.570         0.560  25.5      59.7 9.72e-172    24 -4928. 9907.
## # ... with 3 more variables: BIC <dbl>, deviance <dbl>, df.residual <int>
## # A tibble: 24 x 5
##    term        estimate std.error statistic  p.value
##    <chr>          <dbl>     <dbl>     <dbl>    <dbl>
##  1 (Intercept)    109.       1.80     60.6  0.      
##  2 KielerWoche     14.4      6.73      2.13 3.32e- 2
##  3 Donnerstag      19.8      2.56      7.74 2.37e-14
##  4 Freitag         12.1      2.54      4.77 2.13e- 6
##  5 Montag          16.0      2.57      6.20 7.90e-10
##  6 Samstag         25.4      2.57      9.89 4.20e-22
##  7 Sonntag        -39.3      2.59    -15.2  4.08e-47
##  8 Februar        -13.3      3.07     -4.32 1.71e- 5
##  9 Januar         -14.2      3.00     -4.73 2.52e- 6
## 10 Oktober         17.2      3.42      5.01 6.40e- 7
## # ... with 14 more rows

Dann wird (die Modellgüte) anhand der Test-Stichprobe getestet:

Als Ergebnis wird ein Vektor erzeugt, der für jede Beobachtung des Test-Samples den geschätzten (vorhergesagten) Umsatzwert speichert. Die Gütewerte lassen sich mit caret::postResample ausgeben:

##       RMSE   Rsquared        MAE 
## 32.3989306  0.5949194 24.7391370

Diese Vorhersage-Ergebnisse werden den Test-Daten hinzugefügt und sodann eine gemeinsame Übersichtstabelle für die Gütekennzahlen angelegt lm_vgl_kennz, die nach und nach angereichert wird mit den Ergebnissen der anderen Modelle je Warengruppe:

# Hinzufügen der Ergebnisse
df_lm_test_WG1_21 <- df_lm_test_WG1_21 %>%
  mutate(predicted_inter = lm_WG1_21_predict_inter)

# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
df_lm_test_WG1_21 <- df_lm_test_WG1_21 %>%
  mutate(Prognose_zuhoch = (predicted_inter >= Umsatz)) %>%
  mutate(Abweichung = predicted_inter - Umsatz) %>%
  mutate(Abweichung_abs = abs(predicted_inter - Umsatz)) %>%
  mutate(Abweichung_rel = (predicted_inter - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Ergänze die benötigten Hilfsgrößen
df_lm_test_WG1_21 <-df_lm_test_WG1_21 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- df_lm_test_WG1_21 %>%
  group_by() %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz), 2), Umsatz_mittel = round(sum(Umsatz)/n(), 2), MAE = round(mean(Abweichung_abs), 2), MPE = round(mean(Abweichung_rel)*100, 2), MAPE = round(mean(Abweichung_rel_abs)*100, 2), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100, 2), MSE = round(mean(Abweichung_quad), 2), RMSE = round(sqrt(mean(Abweichung_quad)), 2), rRMSE = round(RMSE/Umsatz_mittel*100, 2))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "best21_inter_WG1")

# füge die Kennzahlen nun an die Vergleichstabelle
lm_vgl_kennz <- rbind(lm_vgl_kennz, temp)
lm_vgl_kennz %>%
  arrange(WAPE)
## # A tibble: 4 x 11
##   Anzahl Umsatz_ges Umsatz_mittel   MAE   MPE  MAPE  WAPE   MSE  RMSE rRMSE
##    <int>      <dbl>         <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1    346     45738.          132.  24.7 -7.93  18.5  18.7 1050.  32.4  24.5
## 2    346     45738.          132.  24.7 -7.91  18.6  18.7 1050.  32.4  24.5
## 3    346     45738.          132.  24.8 -7.65  18.8  18.8 1064.  32.6  24.7
## 4    346     45738.          132.  24.8 -7.84  18.7  18.8 1067.  32.7  24.7
## # ... with 1 more variable: Modell <chr>
## # A tibble: 1 x 11
##   r.squared adj.r.squared sigma statistic   p.value    df logLik   AIC
##       <dbl>         <dbl> <dbl>     <dbl>     <dbl> <int>  <dbl> <dbl>
## 1     0.570         0.560  25.5      57.2 5.52e-171    25 -4928. 9908.
## # ... with 3 more variables: BIC <dbl>, deviance <dbl>, df.residual <int>

Das Hinzufügen des Interaktionseffekts bewirkt hier keine Verbesserung. Somit bleibt es dabei, dass das 21-Variablen-Modell für Warengruppe 1 am besten performt.

Folgende Variablen sind also am besten geeignet, um Prognosen für die Umsätze in der Warengruppe 1 zu erstellen:

  • KielerWoche
  • Wochentage:
    • Donnerstag
    • Freitag
    • Montag
    • Samstag
    • Sonntag
  • Monate:
    • Februar
    • Januar
    • Oktober
    • September
  • Sommerferien:
    • SH
    • NRW
    • NDS
  • Feiertag
  • Ostern
  • ChristiHimmelfahrt
  • Pfingsten
  • TDE
  • Ostern_ext
  • Pfingsten_ext
  • Jahreszeit:
    • Herbst

6.3.2 Warengruppe 2

Erstellung von Trainings- und Testdatensätzen für Warengruppe 2

Auswahl der am besten geeigneten Variablen Was die Vorgehensweise und die enstsprechenden Erläuterungen anbelangt, siehe 6.3.1.

Beste Teilmengenauswahl (“Best subset selection”)

Die regsubsets-Funktion gibt ein Listenobjekt mit vielen Informationen zurück. Zunächst kann der Befehl summary verwendet, um den besten Satz von Variablen für jede Modellgröße zu ermitteln.

## Subset selection object
## Call: regsubsets.formula(Umsatz ~ ., df_lm_train_WG2, nvmax = 37)
## 37 Variables  (and intercept)
##                        Forced in Forced out
## KielerWoche                FALSE      FALSE
## Bewoelkung                 FALSE      FALSE
## Temperatur                 FALSE      FALSE
## Windgeschwindigkeit        FALSE      FALSE
## Wochentag_cDonnerstag      FALSE      FALSE
## Wochentag_cFreitag         FALSE      FALSE
## Wochentag_cMittwoch        FALSE      FALSE
## Wochentag_cMontag          FALSE      FALSE
## Wochentag_cSamstag         FALSE      FALSE
## Wochentag_cSonntag         FALSE      FALSE
## Monat_cAugust              FALSE      FALSE
## Monat_cDezember            FALSE      FALSE
## Monat_cFebruar             FALSE      FALSE
## Monat_cJanuar              FALSE      FALSE
## Monat_cJuli                FALSE      FALSE
## Monat_cJuni                FALSE      FALSE
## Monat_cMai                 FALSE      FALSE
## Monat_cMärz                FALSE      FALSE
## Monat_cNovember            FALSE      FALSE
## Monat_cOktober             FALSE      FALSE
## Monat_cSeptember           FALSE      FALSE
## SommerferienSH             FALSE      FALSE
## SommerferienNRW            FALSE      FALSE
## SommerferienNDS            FALSE      FALSE
## SommerferienHE             FALSE      FALSE
## Feiertag                   FALSE      FALSE
## Ostern                     FALSE      FALSE
## ChristiHimmelfahrt         FALSE      FALSE
## Pfingsten                  FALSE      FALSE
## TDE                        FALSE      FALSE
## Ostern_ext                 FALSE      FALSE
## ChristiHimmelfahrt_ext     FALSE      FALSE
## Pfingsten_ext              FALSE      FALSE
## Silvester_ext              FALSE      FALSE
## JahreszeitHerbst           FALSE      FALSE
## JahreszeitSommer           FALSE      FALSE
## JahreszeitWinter           FALSE      FALSE
## 1 subsets of each size up to 37
## Selection Algorithm: exhaustive
##           KielerWoche Bewoelkung Temperatur Windgeschwindigkeit
## 1  ( 1 )  " "         " "        " "        " "                
## 2  ( 1 )  " "         " "        " "        " "                
## 3  ( 1 )  " "         " "        " "        " "                
## 4  ( 1 )  " "         " "        "*"        " "                
## 5  ( 1 )  " "         " "        "*"        " "                
## 6  ( 1 )  " "         " "        "*"        " "                
## 7  ( 1 )  " "         " "        "*"        " "                
## 8  ( 1 )  "*"         " "        "*"        " "                
## 9  ( 1 )  "*"         " "        "*"        " "                
## 10  ( 1 ) "*"         " "        "*"        " "                
## 11  ( 1 ) "*"         " "        "*"        " "                
## 12  ( 1 ) "*"         " "        "*"        " "                
## 13  ( 1 ) "*"         " "        "*"        " "                
## 14  ( 1 ) "*"         " "        "*"        " "                
## 15  ( 1 ) "*"         " "        "*"        " "                
## 16  ( 1 ) "*"         " "        "*"        " "                
## 17  ( 1 ) "*"         " "        "*"        " "                
## 18  ( 1 ) "*"         " "        "*"        " "                
## 19  ( 1 ) "*"         " "        "*"        " "                
## 20  ( 1 ) "*"         " "        "*"        " "                
## 21  ( 1 ) "*"         " "        "*"        " "                
## 22  ( 1 ) "*"         " "        "*"        " "                
## 23  ( 1 ) "*"         " "        "*"        "*"                
## 24  ( 1 ) "*"         " "        "*"        "*"                
## 25  ( 1 ) "*"         "*"        " "        "*"                
## 26  ( 1 ) "*"         "*"        " "        "*"                
## 27  ( 1 ) "*"         "*"        " "        "*"                
## 28  ( 1 ) "*"         "*"        " "        "*"                
## 29  ( 1 ) "*"         "*"        " "        "*"                
## 30  ( 1 ) "*"         "*"        "*"        "*"                
## 31  ( 1 ) "*"         "*"        "*"        "*"                
## 32  ( 1 ) "*"         "*"        "*"        "*"                
## 33  ( 1 ) "*"         "*"        "*"        "*"                
## 34  ( 1 ) "*"         "*"        "*"        "*"                
## 35  ( 1 ) "*"         "*"        "*"        "*"                
## 36  ( 1 ) "*"         "*"        "*"        "*"                
## 37  ( 1 ) "*"         "*"        "*"        "*"                
##           Wochentag_cDonnerstag Wochentag_cFreitag Wochentag_cMittwoch
## 1  ( 1 )  " "                   " "                " "                
## 2  ( 1 )  " "                   " "                " "                
## 3  ( 1 )  " "                   " "                " "                
## 4  ( 1 )  " "                   " "                " "                
## 5  ( 1 )  " "                   " "                " "                
## 6  ( 1 )  " "                   " "                " "                
## 7  ( 1 )  " "                   " "                " "                
## 8  ( 1 )  " "                   " "                " "                
## 9  ( 1 )  " "                   " "                " "                
## 10  ( 1 ) " "                   " "                " "                
## 11  ( 1 ) " "                   " "                " "                
## 12  ( 1 ) " "                   " "                " "                
## 13  ( 1 ) " "                   " "                " "                
## 14  ( 1 ) " "                   " "                " "                
## 15  ( 1 ) " "                   " "                " "                
## 16  ( 1 ) " "                   " "                " "                
## 17  ( 1 ) " "                   " "                " "                
## 18  ( 1 ) " "                   "*"                " "                
## 19  ( 1 ) " "                   "*"                " "                
## 20  ( 1 ) " "                   "*"                " "                
## 21  ( 1 ) " "                   "*"                " "                
## 22  ( 1 ) " "                   "*"                " "                
## 23  ( 1 ) " "                   "*"                " "                
## 24  ( 1 ) " "                   "*"                " "                
## 25  ( 1 ) " "                   "*"                " "                
## 26  ( 1 ) " "                   "*"                "*"                
## 27  ( 1 ) " "                   "*"                "*"                
## 28  ( 1 ) " "                   "*"                "*"                
## 29  ( 1 ) " "                   "*"                "*"                
## 30  ( 1 ) " "                   "*"                "*"                
## 31  ( 1 ) " "                   "*"                "*"                
## 32  ( 1 ) " "                   "*"                "*"                
## 33  ( 1 ) "*"                   "*"                " "                
## 34  ( 1 ) "*"                   "*"                "*"                
## 35  ( 1 ) "*"                   "*"                "*"                
## 36  ( 1 ) "*"                   "*"                "*"                
## 37  ( 1 ) "*"                   "*"                "*"                
##           Wochentag_cMontag Wochentag_cSamstag Wochentag_cSonntag
## 1  ( 1 )  " "               " "                " "               
## 2  ( 1 )  " "               " "                "*"               
## 3  ( 1 )  " "               "*"                "*"               
## 4  ( 1 )  " "               "*"                "*"               
## 5  ( 1 )  " "               "*"                "*"               
## 6  ( 1 )  " "               "*"                "*"               
## 7  ( 1 )  " "               "*"                "*"               
## 8  ( 1 )  " "               "*"                "*"               
## 9  ( 1 )  " "               "*"                "*"               
## 10  ( 1 ) " "               "*"                "*"               
## 11  ( 1 ) " "               "*"                "*"               
## 12  ( 1 ) " "               "*"                "*"               
## 13  ( 1 ) " "               "*"                "*"               
## 14  ( 1 ) " "               "*"                "*"               
## 15  ( 1 ) " "               "*"                "*"               
## 16  ( 1 ) " "               "*"                "*"               
## 17  ( 1 ) " "               "*"                "*"               
## 18  ( 1 ) " "               "*"                "*"               
## 19  ( 1 ) " "               "*"                "*"               
## 20  ( 1 ) " "               "*"                "*"               
## 21  ( 1 ) " "               "*"                "*"               
## 22  ( 1 ) " "               "*"                "*"               
## 23  ( 1 ) " "               "*"                "*"               
## 24  ( 1 ) " "               "*"                "*"               
## 25  ( 1 ) " "               "*"                "*"               
## 26  ( 1 ) " "               "*"                "*"               
## 27  ( 1 ) " "               "*"                "*"               
## 28  ( 1 ) " "               "*"                "*"               
## 29  ( 1 ) " "               "*"                "*"               
## 30  ( 1 ) " "               "*"                "*"               
## 31  ( 1 ) " "               "*"                "*"               
## 32  ( 1 ) " "               "*"                "*"               
## 33  ( 1 ) "*"               "*"                "*"               
## 34  ( 1 ) "*"               "*"                "*"               
## 35  ( 1 ) "*"               "*"                "*"               
## 36  ( 1 ) "*"               "*"                "*"               
## 37  ( 1 ) "*"               "*"                "*"               
##           Monat_cAugust Monat_cDezember Monat_cFebruar Monat_cJanuar
## 1  ( 1 )  " "           " "             " "            " "          
## 2  ( 1 )  " "           " "             " "            " "          
## 3  ( 1 )  " "           " "             " "            " "          
## 4  ( 1 )  " "           " "             " "            " "          
## 5  ( 1 )  " "           " "             " "            " "          
## 6  ( 1 )  " "           " "             " "            " "          
## 7  ( 1 )  " "           " "             " "            " "          
## 8  ( 1 )  " "           " "             " "            " "          
## 9  ( 1 )  " "           " "             " "            " "          
## 10  ( 1 ) " "           " "             " "            " "          
## 11  ( 1 ) " "           " "             " "            " "          
## 12  ( 1 ) " "           " "             " "            " "          
## 13  ( 1 ) " "           " "             " "            " "          
## 14  ( 1 ) " "           " "             " "            " "          
## 15  ( 1 ) " "           " "             " "            " "          
## 16  ( 1 ) " "           " "             " "            " "          
## 17  ( 1 ) " "           " "             " "            " "          
## 18  ( 1 ) " "           " "             " "            " "          
## 19  ( 1 ) " "           " "             " "            "*"          
## 20  ( 1 ) " "           " "             "*"            "*"          
## 21  ( 1 ) "*"           " "             " "            " "          
## 22  ( 1 ) "*"           "*"             " "            " "          
## 23  ( 1 ) "*"           "*"             " "            " "          
## 24  ( 1 ) "*"           "*"             " "            " "          
## 25  ( 1 ) "*"           "*"             " "            " "          
## 26  ( 1 ) "*"           "*"             " "            " "          
## 27  ( 1 ) "*"           "*"             " "            " "          
## 28  ( 1 ) "*"           "*"             "*"            " "          
## 29  ( 1 ) "*"           "*"             "*"            " "          
## 30  ( 1 ) "*"           "*"             "*"            " "          
## 31  ( 1 ) "*"           "*"             "*"            " "          
## 32  ( 1 ) "*"           "*"             "*"            " "          
## 33  ( 1 ) "*"           "*"             "*"            " "          
## 34  ( 1 ) "*"           "*"             "*"            " "          
## 35  ( 1 ) "*"           "*"             " "            "*"          
## 36  ( 1 ) "*"           "*"             "*"            "*"          
## 37  ( 1 ) "*"           "*"             "*"            "*"          
##           Monat_cJuli Monat_cJuni Monat_cMai Monat_cMärz Monat_cNovember
## 1  ( 1 )  " "         " "         " "        " "         " "            
## 2  ( 1 )  " "         " "         " "        " "         " "            
## 3  ( 1 )  " "         " "         " "        " "         " "            
## 4  ( 1 )  " "         " "         " "        " "         " "            
## 5  ( 1 )  " "         " "         " "        " "         " "            
## 6  ( 1 )  " "         " "         " "        " "         " "            
## 7  ( 1 )  " "         " "         " "        " "         " "            
## 8  ( 1 )  " "         " "         " "        " "         " "            
## 9  ( 1 )  " "         " "         " "        " "         "*"            
## 10  ( 1 ) " "         " "         " "        " "         " "            
## 11  ( 1 ) " "         " "         " "        " "         " "            
## 12  ( 1 ) " "         " "         " "        " "         " "            
## 13  ( 1 ) " "         " "         " "        " "         " "            
## 14  ( 1 ) " "         " "         " "        " "         " "            
## 15  ( 1 ) " "         " "         " "        " "         " "            
## 16  ( 1 ) " "         " "         " "        " "         " "            
## 17  ( 1 ) " "         " "         " "        "*"         " "            
## 18  ( 1 ) " "         " "         " "        "*"         " "            
## 19  ( 1 ) " "         " "         " "        "*"         " "            
## 20  ( 1 ) " "         " "         " "        "*"         " "            
## 21  ( 1 ) "*"         "*"         "*"        " "         " "            
## 22  ( 1 ) "*"         "*"         "*"        " "         " "            
## 23  ( 1 ) "*"         "*"         "*"        " "         " "            
## 24  ( 1 ) "*"         "*"         "*"        " "         "*"            
## 25  ( 1 ) "*"         "*"         "*"        " "         "*"            
## 26  ( 1 ) "*"         "*"         "*"        " "         "*"            
## 27  ( 1 ) "*"         "*"         "*"        " "         "*"            
## 28  ( 1 ) "*"         "*"         "*"        " "         "*"            
## 29  ( 1 ) "*"         "*"         "*"        " "         "*"            
## 30  ( 1 ) "*"         "*"         "*"        " "         "*"            
## 31  ( 1 ) "*"         "*"         "*"        " "         "*"            
## 32  ( 1 ) "*"         "*"         "*"        " "         "*"            
## 33  ( 1 ) "*"         "*"         "*"        " "         "*"            
## 34  ( 1 ) "*"         "*"         "*"        " "         "*"            
## 35  ( 1 ) "*"         "*"         "*"        "*"         "*"            
## 36  ( 1 ) "*"         "*"         "*"        "*"         "*"            
## 37  ( 1 ) "*"         "*"         "*"        "*"         "*"            
##           Monat_cOktober Monat_cSeptember SommerferienSH SommerferienNRW
## 1  ( 1 )  " "            " "              " "            " "            
## 2  ( 1 )  " "            " "              " "            " "            
## 3  ( 1 )  " "            " "              " "            " "            
## 4  ( 1 )  " "            " "              " "            "*"            
## 5  ( 1 )  " "            " "              " "            "*"            
## 6  ( 1 )  " "            " "              " "            "*"            
## 7  ( 1 )  " "            " "              " "            "*"            
## 8  ( 1 )  " "            " "              " "            "*"            
## 9  ( 1 )  " "            " "              " "            "*"            
## 10  ( 1 ) "*"            " "              " "            "*"            
## 11  ( 1 ) "*"            " "              " "            "*"            
## 12  ( 1 ) "*"            " "              " "            "*"            
## 13  ( 1 ) "*"            " "              " "            "*"            
## 14  ( 1 ) "*"            " "              "*"            "*"            
## 15  ( 1 ) "*"            " "              "*"            "*"            
## 16  ( 1 ) "*"            "*"              "*"            "*"            
## 17  ( 1 ) "*"            "*"              "*"            "*"            
## 18  ( 1 ) "*"            "*"              "*"            "*"            
## 19  ( 1 ) "*"            "*"              "*"            "*"            
## 20  ( 1 ) "*"            "*"              "*"            "*"            
## 21  ( 1 ) "*"            "*"              "*"            "*"            
## 22  ( 1 ) "*"            "*"              "*"            "*"            
## 23  ( 1 ) "*"            "*"              "*"            "*"            
## 24  ( 1 ) "*"            "*"              "*"            "*"            
## 25  ( 1 ) "*"            "*"              "*"            "*"            
## 26  ( 1 ) "*"            "*"              "*"            "*"            
## 27  ( 1 ) "*"            "*"              "*"            "*"            
## 28  ( 1 ) "*"            "*"              "*"            "*"            
## 29  ( 1 ) "*"            "*"              "*"            "*"            
## 30  ( 1 ) "*"            "*"              "*"            "*"            
## 31  ( 1 ) "*"            "*"              "*"            "*"            
## 32  ( 1 ) "*"            "*"              "*"            "*"            
## 33  ( 1 ) "*"            "*"              "*"            "*"            
## 34  ( 1 ) "*"            "*"              "*"            "*"            
## 35  ( 1 ) "*"            "*"              "*"            "*"            
## 36  ( 1 ) "*"            "*"              "*"            "*"            
## 37  ( 1 ) "*"            "*"              "*"            "*"            
##           SommerferienNDS SommerferienHE Feiertag Ostern
## 1  ( 1 )  " "             " "            " "      " "   
## 2  ( 1 )  " "             " "            " "      " "   
## 3  ( 1 )  " "             " "            " "      " "   
## 4  ( 1 )  " "             " "            " "      " "   
## 5  ( 1 )  " "             " "            "*"      " "   
## 6  ( 1 )  " "             "*"            "*"      " "   
## 7  ( 1 )  " "             "*"            "*"      " "   
## 8  ( 1 )  " "             "*"            "*"      " "   
## 9  ( 1 )  " "             "*"            "*"      " "   
## 10  ( 1 ) " "             "*"            "*"      " "   
## 11  ( 1 ) " "             "*"            "*"      " "   
## 12  ( 1 ) " "             "*"            " "      " "   
## 13  ( 1 ) " "             "*"            " "      " "   
## 14  ( 1 ) "*"             "*"            " "      " "   
## 15  ( 1 ) "*"             "*"            "*"      " "   
## 16  ( 1 ) "*"             "*"            "*"      " "   
## 17  ( 1 ) "*"             "*"            "*"      " "   
## 18  ( 1 ) "*"             "*"            "*"      " "   
## 19  ( 1 ) "*"             "*"            "*"      " "   
## 20  ( 1 ) "*"             "*"            "*"      " "   
## 21  ( 1 ) "*"             "*"            "*"      " "   
## 22  ( 1 ) "*"             "*"            "*"      " "   
## 23  ( 1 ) "*"             "*"            "*"      " "   
## 24  ( 1 ) "*"             "*"            "*"      " "   
## 25  ( 1 ) "*"             "*"            "*"      " "   
## 26  ( 1 ) "*"             "*"            "*"      " "   
## 27  ( 1 ) "*"             "*"            "*"      "*"   
## 28  ( 1 ) "*"             "*"            "*"      " "   
## 29  ( 1 ) "*"             "*"            "*"      "*"   
## 30  ( 1 ) "*"             "*"            "*"      "*"   
## 31  ( 1 ) "*"             "*"            "*"      "*"   
## 32  ( 1 ) "*"             "*"            "*"      " "   
## 33  ( 1 ) "*"             "*"            "*"      " "   
## 34  ( 1 ) "*"             "*"            "*"      " "   
## 35  ( 1 ) "*"             "*"            "*"      " "   
## 36  ( 1 ) "*"             "*"            "*"      " "   
## 37  ( 1 ) "*"             "*"            "*"      "*"   
##           ChristiHimmelfahrt Pfingsten TDE Ostern_ext
## 1  ( 1 )  " "                " "       " " " "       
## 2  ( 1 )  " "                " "       " " " "       
## 3  ( 1 )  " "                " "       " " " "       
## 4  ( 1 )  " "                " "       " " " "       
## 5  ( 1 )  " "                " "       " " " "       
## 6  ( 1 )  " "                " "       " " " "       
## 7  ( 1 )  " "                " "       " " "*"       
## 8  ( 1 )  " "                " "       " " "*"       
## 9  ( 1 )  " "                " "       " " "*"       
## 10  ( 1 ) " "                " "       " " "*"       
## 11  ( 1 ) " "                " "       " " "*"       
## 12  ( 1 ) " "                "*"       " " "*"       
## 13  ( 1 ) " "                "*"       " " "*"       
## 14  ( 1 ) " "                "*"       " " "*"       
## 15  ( 1 ) " "                " "       " " "*"       
## 16  ( 1 ) " "                " "       " " "*"       
## 17  ( 1 ) " "                " "       " " "*"       
## 18  ( 1 ) " "                " "       " " "*"       
## 19  ( 1 ) " "                " "       " " "*"       
## 20  ( 1 ) " "                " "       " " "*"       
## 21  ( 1 ) " "                " "       " " "*"       
## 22  ( 1 ) " "                " "       " " "*"       
## 23  ( 1 ) " "                " "       " " "*"       
## 24  ( 1 ) " "                " "       " " "*"       
## 25  ( 1 ) " "                " "       " " "*"       
## 26  ( 1 ) " "                " "       " " "*"       
## 27  ( 1 ) " "                " "       " " "*"       
## 28  ( 1 ) " "                " "       " " "*"       
## 29  ( 1 ) " "                " "       " " "*"       
## 30  ( 1 ) " "                " "       " " "*"       
## 31  ( 1 ) " "                "*"       " " "*"       
## 32  ( 1 ) "*"                "*"       "*" "*"       
## 33  ( 1 ) "*"                "*"       "*" "*"       
## 34  ( 1 ) "*"                "*"       "*" "*"       
## 35  ( 1 ) "*"                "*"       "*" "*"       
## 36  ( 1 ) "*"                "*"       "*" "*"       
## 37  ( 1 ) "*"                "*"       "*" "*"       
##           ChristiHimmelfahrt_ext Pfingsten_ext Silvester_ext
## 1  ( 1 )  " "                    " "           " "          
## 2  ( 1 )  " "                    " "           " "          
## 3  ( 1 )  " "                    " "           " "          
## 4  ( 1 )  " "                    " "           " "          
## 5  ( 1 )  " "                    " "           " "          
## 6  ( 1 )  " "                    " "           " "          
## 7  ( 1 )  " "                    " "           " "          
## 8  ( 1 )  " "                    " "           " "          
## 9  ( 1 )  " "                    " "           " "          
## 10  ( 1 ) " "                    " "           " "          
## 11  ( 1 ) " "                    " "           "*"          
## 12  ( 1 ) "*"                    " "           "*"          
## 13  ( 1 ) "*"                    " "           "*"          
## 14  ( 1 ) "*"                    " "           "*"          
## 15  ( 1 ) "*"                    "*"           "*"          
## 16  ( 1 ) "*"                    "*"           "*"          
## 17  ( 1 ) "*"                    "*"           "*"          
## 18  ( 1 ) "*"                    "*"           "*"          
## 19  ( 1 ) "*"                    "*"           "*"          
## 20  ( 1 ) "*"                    "*"           "*"          
## 21  ( 1 ) "*"                    "*"           "*"          
## 22  ( 1 ) "*"                    "*"           "*"          
## 23  ( 1 ) "*"                    "*"           "*"          
## 24  ( 1 ) "*"                    "*"           "*"          
## 25  ( 1 ) "*"                    "*"           "*"          
## 26  ( 1 ) "*"                    "*"           "*"          
## 27  ( 1 ) "*"                    "*"           "*"          
## 28  ( 1 ) "*"                    "*"           "*"          
## 29  ( 1 ) "*"                    "*"           "*"          
## 30  ( 1 ) "*"                    "*"           "*"          
## 31  ( 1 ) "*"                    "*"           "*"          
## 32  ( 1 ) "*"                    "*"           "*"          
## 33  ( 1 ) "*"                    "*"           "*"          
## 34  ( 1 ) "*"                    "*"           "*"          
## 35  ( 1 ) "*"                    "*"           "*"          
## 36  ( 1 ) "*"                    "*"           "*"          
## 37  ( 1 ) "*"                    "*"           "*"          
##           JahreszeitHerbst JahreszeitSommer JahreszeitWinter
## 1  ( 1 )  " "              "*"              " "             
## 2  ( 1 )  " "              "*"              " "             
## 3  ( 1 )  " "              "*"              " "             
## 4  ( 1 )  " "              " "              " "             
## 5  ( 1 )  " "              " "              " "             
## 6  ( 1 )  " "              " "              " "             
## 7  ( 1 )  " "              " "              " "             
## 8  ( 1 )  " "              " "              " "             
## 9  ( 1 )  " "              " "              " "             
## 10  ( 1 ) "*"              " "              " "             
## 11  ( 1 ) "*"              " "              " "             
## 12  ( 1 ) "*"              " "              " "             
## 13  ( 1 ) "*"              "*"              " "             
## 14  ( 1 ) "*"              " "              " "             
## 15  ( 1 ) "*"              " "              " "             
## 16  ( 1 ) "*"              " "              " "             
## 17  ( 1 ) "*"              " "              " "             
## 18  ( 1 ) "*"              " "              " "             
## 19  ( 1 ) "*"              " "              " "             
## 20  ( 1 ) "*"              " "              " "             
## 21  ( 1 ) "*"              " "              " "             
## 22  ( 1 ) "*"              " "              " "             
## 23  ( 1 ) "*"              " "              " "             
## 24  ( 1 ) "*"              " "              " "             
## 25  ( 1 ) "*"              " "              "*"             
## 26  ( 1 ) "*"              " "              "*"             
## 27  ( 1 ) "*"              " "              "*"             
## 28  ( 1 ) "*"              "*"              "*"             
## 29  ( 1 ) "*"              "*"              "*"             
## 30  ( 1 ) "*"              "*"              "*"             
## 31  ( 1 ) "*"              "*"              "*"             
## 32  ( 1 ) "*"              "*"              "*"             
## 33  ( 1 ) "*"              "*"              "*"             
## 34  ( 1 ) "*"              "*"              "*"             
## 35  ( 1 ) "*"              "*"              "*"             
## 36  ( 1 ) "*"              "*"              "*"             
## 37  ( 1 ) "*"              "*"              "*"

Für ein Modell mit einer Variablen kann beobachtet werden, dass die erzeugte Dummy-Variable Sommer ein Sternchen hat, was signalisiert, dass ein Regressionsmodell mit Umsatz ~ Sommer das beste Einzelvariablenmodell ist. Das beste 2-Variablen-Modell ist Umsatz ~ Sommer + Wochentag_cSonntag. Das beste 3-Variablen-Modell ist Umsatz ~ Sommer + Wochentag_cSonntag + Wochentag_cSamstag. Das beste 4-Variablen-Modell ist interessant: Umsatz ~ Wochentag_cSonntag + Wochentag_cSamstag + SommerferienNRW + Temperatur. Die Variable Sommer taucht in diesem Modell nicht mehr auf; allerdings wird diese indirekt einbezogen, da sowohl die Tempertaur als auch die Sommerferien NRW mit dem Sommer verknüpft sind.

Schrittweise Auswahl (“Stepwise selection”)

Schrittweise vorwärts (Forward stepwise)

Die schrittweise Vorwärtsauswahl kann mit regsubsets durchgeführt werden, indem die method = "forward" gesetzt wird:

Schrittweise rückwärts (Backward stepwise)

Die schrittweise Vorwärtsauswahl kann mit regsubsets durchgeführt werden, indem die method = "backward" gesetzt wird:

Modellauswahl

Indirekte Schätzung des Testfehlers mit \(C_{p}\), \(AIC\), \(BIC\) und adjustiertem \(R^2\)

## [1] 32
## [1] 23
## [1] 29

Es ist erkennbar, dass die Ergebnisse leicht unterschiedliche Modelle identifizieren, die als die besten angesehen werden. Die ajustierte \(R^2\)-Statistik legt nahe, dass das 32-Variablen-Modell bevorzugt wird, die \(BIC\)-Statistik schlägt das 23-Variablenmodell vor und der \(C_{p}\) das 29-Variablen-Modell vor.

Der gleiche Prozess kann durch schrittweise Vorwärts- und Rückwärtsauswahl durchgeführt werden, um noch mehr Optionen für optimale Modelle zu erhalten:

## [1] 31
## [1] 29

Wenn man das optimale \(C_{p}\) für vorwärts und rückwärts schrittweise bewertet, ist erkennbar, dass gemäß der Vorwärts-Methode ein 31-Variablen-Modell die \(C_{p}\)-Statistik minimiert. Die Rückwärtsmethode schlägt ein 29-Variablen-Modell vor.

Wenn wir die Koeffizienten dieser Modelle bewerten, ergibt sich bzgl. der Zusammensetzung der Prädikatoren folgendes Bild:

##            (Intercept)            KielerWoche             Temperatur 
##             255.058980              99.262851               1.539860 
##    Windgeschwindigkeit     Wochentag_cFreitag     Wochentag_cSamstag 
##               1.024593              15.898462             104.370577 
##     Wochentag_cSonntag          Monat_cAugust        Monat_cDezember 
##             159.502725              51.265505              18.703341 
##            Monat_cJuli            Monat_cJuni             Monat_cMai 
##              61.459395              51.609523              38.326687 
##         Monat_cOktober       Monat_cSeptember         SommerferienSH 
##              85.540654              57.119460              50.541531 
##        SommerferienNRW        SommerferienNDS         SommerferienHE 
##              87.469236              28.601771              51.119857 
##               Feiertag             Ostern_ext ChristiHimmelfahrt_ext 
##              74.085008             227.664940              87.741193 
##          Pfingsten_ext          Silvester_ext       JahreszeitHerbst 
##              65.794712             154.771010             -36.760166

Folgende Variablen werden in das 23-Variablen-Modell integriert:

  • KielerWoche
  • Temperatur
  • Windgeschwindigkeit
  • Wochentag_cFreitag
  • Wochentag_cSamstag
  • Wochentag_cSonntag
  • Monat_cAugust
  • Monat_cDezember
  • Monat_cJuli
  • Monat_cJuni
  • Monat_cMai
  • Monat_cOktober
  • Monat_cSeptember
  • SommerferienSH
  • SommerferienNRW
  • SommerferienNDS
  • SommerferienHE
  • Feiertag
  • Ostern_ext
  • ChristiHimmelfahrt_ext
  • Pfingsten_ext
  • Silvester_ext
  • JahreszeitHerbst
##            (Intercept)            KielerWoche             Bewoelkung 
##            285.1959994            110.6825404             -1.7340847 
##    Windgeschwindigkeit     Wochentag_cFreitag    Wochentag_cMittwoch 
##              0.9935373             14.1250135             -8.6086174 
##     Wochentag_cSamstag     Wochentag_cSonntag          Monat_cAugust 
##            101.7853127            157.2936678             79.2083263 
##        Monat_cDezember         Monat_cFebruar            Monat_cJuli 
##             44.9063897             11.4307856             85.7339271 
##            Monat_cJuni             Monat_cMai        Monat_cNovember 
##             61.6719636             41.6951069             38.5158005 
##         Monat_cOktober       Monat_cSeptember         SommerferienSH 
##            123.7686825             88.1214251             48.4301824 
##        SommerferienNRW        SommerferienNDS         SommerferienHE 
##             90.7737369             35.1848596             48.7233272 
##               Feiertag                 Ostern             Ostern_ext 
##             84.4931092            -54.5178447            243.8465559 
## ChristiHimmelfahrt_ext          Pfingsten_ext          Silvester_ext 
##             85.8960768             57.2657853            135.3120143 
##       JahreszeitHerbst       JahreszeitSommer       JahreszeitWinter 
##            -75.4096447            -18.7240422            -20.5139300

Beim 29-Variablen-Modell werden folgende Variablen gegenüber dem 23-Variablen-Modell ergänzt:

  • Wochentag_cMittwoch
  • Monat_cFebruar
  • Monat_cNovember
  • Ostern
  • JahreszeitSommer
  • JahreszeitWinter

Weiterhin wurde die Temperatur gegen die Variable Bewoelkung “getauscht”.

##            (Intercept)            KielerWoche             Bewoelkung 
##            277.0558412            109.1795588             -1.4125293 
##             Temperatur    Windgeschwindigkeit     Wochentag_cFreitag 
##              0.7115207              0.9795046             13.8471461 
##    Wochentag_cMittwoch     Wochentag_cSamstag     Wochentag_cSonntag 
##             -8.7469925            102.0402273            157.1575563 
##          Monat_cAugust        Monat_cDezember         Monat_cFebruar 
##             70.9326129             43.7719952             11.5790448 
##            Monat_cJuli            Monat_cJuni             Monat_cMai 
##             78.0819735             55.5365463             37.7302208 
##        Monat_cNovember         Monat_cOktober       Monat_cSeptember 
##             36.8293615            118.5573140             80.8000391 
##         SommerferienSH        SommerferienNRW        SommerferienNDS 
##             48.8069000             90.1958932             34.5184450 
##         SommerferienHE               Feiertag     ChristiHimmelfahrt 
##             48.5570764             30.4854986             48.2951446 
##              Pfingsten                    TDE             Ostern_ext 
##             80.9105178             58.1758050            244.5138648 
## ChristiHimmelfahrt_ext          Pfingsten_ext          Silvester_ext 
##             86.5497501             44.9883011            162.9135444 
##       JahreszeitHerbst       JahreszeitSommer       JahreszeitWinter 
##            -72.2681414            -17.3824973            -16.9097959
  • KielerWoche
  • Bewoelkung
  • Temperatur
  • Windgeschwindigkeit
  • Wochentag_cFreitag
  • Wochentag_cMittwoch
  • Wochentag_cSamstag
  • Wochentag_cSonntag
  • Monat_cAugust
  • Monat_cDezember
  • Monat_cFebruar
  • Monat_cJuli
  • Monat_cJuni
  • Monat_cMai
  • Monat_cNovember
  • Monat_cOktober
  • Monat_cSeptember
  • SommerferienSH
  • SommerferienNRW
  • SommerferienNDS
  • SommerferienHE
  • Feiertag
  • ChristiHimmelfahrt
  • Pfingsten
  • TDE
  • Ostern_ext
  • ChristiHimmelfahrt_ext
  • Pfingsten_ext
  • Silvester_ext
  • JahreszeitHerbst
  • JahreszeitSommer
  • JahreszeitWinter

Der Unterschied zwischen Prädiktoren im 29- und 32-Variablen-Modell besteht größtenteils aus einer Erweiterung (fett marktierte Variablen). Nicht mehr dabei ist die Variable Ostern.

##            (Intercept)            KielerWoche             Bewoelkung 
##            278.8911307            105.7241313             -1.4456642 
##             Temperatur    Windgeschwindigkeit     Wochentag_cFreitag 
##              0.7658329              1.0186900             13.6069261 
##    Wochentag_cMittwoch     Wochentag_cSamstag     Wochentag_cSonntag 
##             -9.0063870            102.2745335            156.5837730 
##          Monat_cAugust        Monat_cDezember         Monat_cFebruar 
##             61.0043068             28.5646504             -7.4996625 
##          Monat_cJanuar            Monat_cJuli            Monat_cJuni 
##            -18.6575385             69.5644438             51.5651333 
##             Monat_cMai            Monat_cMärz        Monat_cNovember 
##             34.8087325            -16.1000529             22.8978618 
##         Monat_cOktober       Monat_cSeptember         SommerferienSH 
##            105.2746621             69.4633491             49.3516639 
##        SommerferienNRW        SommerferienNDS         SommerferienHE 
##             89.0775459             32.5576980             49.5702330 
##               Feiertag              Pfingsten             Ostern_ext 
##             60.9717893             50.7706527            229.7017974 
## ChristiHimmelfahrt_ext          Pfingsten_ext          Silvester_ext 
##             90.0427705             45.2939007            143.7739953 
##       JahreszeitHerbst       JahreszeitSommer 
##            -60.6462949            -10.3004626
##            (Intercept)            KielerWoche             Bewoelkung 
##            266.8760830            100.6303933             -1.4806830 
##             Temperatur    Windgeschwindigkeit  Wochentag_cDonnerstag 
##              0.9248882              1.0762859              9.0862054 
##     Wochentag_cFreitag      Wochentag_cMontag     Wochentag_cSamstag 
##             20.3717443              7.9979502            108.8098510 
##     Wochentag_cSonntag          Monat_cAugust        Monat_cDezember 
##            163.5665803             53.1171170             28.1964327 
##          Monat_cJanuar            Monat_cJuli            Monat_cJuni 
##            -14.0033239             62.8094016             51.9772611 
##             Monat_cMai            Monat_cMärz        Monat_cNovember 
##             37.3506429            -12.4817405             20.8335466 
##         Monat_cOktober       Monat_cSeptember         SommerferienSH 
##            102.0348318             62.6385147             49.4140697 
##        SommerferienNRW        SommerferienNDS         SommerferienHE 
##             88.3186268             30.0781344             50.6258543 
##               Feiertag             Ostern_ext ChristiHimmelfahrt_ext 
##             72.0622903            225.2186266             86.3047370 
##          Pfingsten_ext          Silvester_ext       JahreszeitHerbst 
##             67.2084386            142.0156830            -54.7108141

Vergleicht man, das 29-Variablen-Modell der best subset selection mit dem 27-Variablen-Modell der backward selection wird erkennbar, dass die Modelle zwar viele gemeinsame Prädiktoren (24) aufnehmen, dass es jedoch auch deutliche Abweichungen bzw. Unterschiede gibt:

Während in der best subset selection ein Wochentag (Mittwoch), ein Monat (Februar), Ostern und zwei Jahreszeiten (Sommer, Winter) einbezogen werden, sollten nach der backward selection die Temperatur, zwei Wochentage (Donnerstag und Montag) sowie zwei Monate (Januar, März) in das Modell aufgenommen werden.

Ein Vergleich des best subset 32-Variablen-Modell mit dem backward selection 31-Variablen-Modell nach forward selection ergibt folgendes:

Die beiden Modelle unterscheiden sich zwar nur marginal, aber auch hier gibt es Unterschiede zwischen der best subset selection und der stepwise selection.

Diese Ergebnisse unterstreicht zwei wichtige Erkenntnisse:

  • Unterschiedliche Teilmengenverfahren (beste Teilmenge vs. schrittweise vorwärts oder rückwärts schrittweise) identifizieren durchaus nicht selten unterschiedliche „beste“ Modelle.
  • Unterschiedliche Statistiken zur indirekten Fehlertestschätzung (\(C_p\), \(AIC\), \(BIC\) und \(Adjusted\) \(R^2\)) indentifizieren verschiedene „beste“ Modelle.

Aus diesem Grund ist es wichtig, immer eine Validierung durchzuführen. Dies bedeutet, dass der Testfehler immer direkt geschätzt werden sollte, entweder mithilfe eines Validierungssatzes oder mithilfe einer Kreuzvalidierung.

Direkte Schätzung des Testfehlers

Nun wird der Fehler der Testdaten für das beste Modell jeder Modellgröße berechnet. Zuerst wird eine Modellmatrix aus den Testdaten erstellt. Die Funktion model.matrix wird in vielen Regressionspaketen zum Erstellen einer X-Matrix aus Daten verwendet.

Jetzt kann jede Modellgröße (d.h. 1 Variable, 2 Variablen,…, 20 Variablen) durchlaufen werden und die Koeffizienten für das beste Modell dieser Größe extrahiert werden. Diese Werte werden sodann in die entsprechenden Spalten der Testmodellmatrix multipliziert, um die Vorhersagen zu bilden. Dann werden die Test-MSE berechnet.

Es ist erkennbar, dass ein 24-Variablen-Modell, das durch den besten Teilmengenansatz erzeugt wird, den niedrigsten Test-MSE erzeugt. Auch ein 30-Variablen-Modell scheinz vergleichweichsweise gut zu performen.

Wir können jetzt die beste Teilmengenauswahl für den gesamten Datensatz durchführen, um zum einen das 24-Variablen-Modell zu erhalten. Dieses Modell wird mit den 32-Variablen-Modellen nach Best subset selection verglichen. Diese Modelle werden sodann mit den 29-Variablen-Modellen verglichen.

Teilmengenauswahl für das 24-Variablen-Modell

##            (Intercept)            KielerWoche             Temperatur 
##             253.991013              99.330538               1.444194 
##    Windgeschwindigkeit     Wochentag_cFreitag     Wochentag_cSamstag 
##               1.018136              16.102352             104.533282 
##     Wochentag_cSonntag          Monat_cAugust        Monat_cDezember 
##             159.530591              55.287643              33.123450 
##            Monat_cJuli            Monat_cJuni             Monat_cMai 
##              64.625104              54.435465              40.897683 
##        Monat_cNovember         Monat_cOktober       Monat_cSeptember 
##              25.758081             104.862197              64.873315 
##         SommerferienSH        SommerferienNRW        SommerferienNDS 
##              49.518634              87.740027              28.669983 
##         SommerferienHE               Feiertag             Ostern_ext 
##              50.834005              74.165151             229.519850 
## ChristiHimmelfahrt_ext          Pfingsten_ext          Silvester_ext 
##              87.841329              65.552466             141.775252 
##       JahreszeitHerbst 
##             -53.857328

Die 24 Variablen sind die folgenden:

  • KielerWoche
  • Temperatur
  • Windgeschwindigkeit
  • Wochentag_cFreitag
  • Wochentag_cSamstag
  • Wochentag_cSonntag
  • Monat_cAugust
  • Monat_cDezember
  • Monat_cJuli
  • Monat_cJuni
  • Monat_cMai
  • Monat_cNovember
  • Monat_cOktober
  • Monat_cSeptember
  • SommerferienSH
  • SommerferienNRW
  • SommerferienNDS
  • SommerferienHE
  • Feiertag
  • Ostern_ext
  • ChristiHimmelfahrt_ext
  • Pfingsten_ext
  • Silvester_ext
  • JahreszeitHerbst

Die Variablen Wochentag_c, Monat und Jahreszeit nun noch dummyfiziert werden (bei Einbeziehung aller Variablen erfolgt die Dummyfizierung automatisch im Rahmen der Regressionsanalyse): Für jeden Wochentag wird eine Variable mit Ausprägung 0/1 gebildet und danach die alte Variable Wochentag_c entfernt. Analog wird bei den beiden anderen Variablen vorgegangen.

# Dummyfizierung der Variablen im Trainigsdatensatz:
df_lm_train_WG2_24 <- df_lm_train_WG2 %>%
  mutate(Montag=as.integer(df_lm_train_WG2$Wochentag_c=="Montag")) %>%
  mutate(Dienstag=as.integer(df_lm_train_WG2$Wochentag_c=="Dienstag")) %>%
  mutate(Mittwoch=as.integer(df_lm_train_WG2$Wochentag_c=="Mittwoch")) %>%
  mutate(Donnerstag=as.integer(df_lm_train_WG2$Wochentag_c=="Donnerstag")) %>%
  mutate(Freitag=as.integer(df_lm_train_WG2$Wochentag_c=="Freitag")) %>%
  mutate(Samstag=as.integer(df_lm_train_WG2$Wochentag_c=="Samstag")) %>%
  mutate(Sonntag=as.integer(df_lm_train_WG2$Wochentag_c=="Sonntag")) %>%
  mutate(Januar=as.integer(df_lm_train_WG2$Monat_c=="Januar")) %>%
  mutate(Februar=as.integer(df_lm_train_WG2$Monat_c=="Februar")) %>%
  mutate(Maerz=as.integer(df_lm_train_WG2$Monat_c=="März")) %>%
  mutate(April=as.integer(df_lm_train_WG2$Monat_c=="April")) %>%
  mutate(Mai=as.integer(df_lm_train_WG2$Monat_c=="Mai")) %>%
  mutate(Juni=as.integer(df_lm_train_WG2$Monat_c=="Juni")) %>%
  mutate(Juli=as.integer(df_lm_train_WG2$Monat_c=="Juli")) %>%
  mutate(August=as.integer(df_lm_train_WG2$Monat_c=="August")) %>%
  mutate(September=as.integer(df_lm_train_WG2$Monat_c=="September")) %>%
  mutate(Oktober=as.integer(df_lm_train_WG2$Monat_c=="Oktober")) %>%
  mutate(November=as.integer(df_lm_train_WG2$Monat_c=="November")) %>%
  mutate(Dezember=as.integer(df_lm_train_WG2$Monat_c=="Dezember")) %>%
  mutate(Fruehling=as.integer(df_lm_train_WG2$Jahreszeit=="Fruehling")) %>%
  mutate(Sommer=as.integer(df_lm_train_WG2$Jahreszeit=="Sommer")) %>%
  mutate(Herbst=as.integer(df_lm_train_WG2$Jahreszeit=="Herbst")) %>%
  mutate(Winter=as.integer(df_lm_train_WG2$Jahreszeit=="Winter")) %>%
  dplyr::select(-Wochentag_c, -Monat_c, -Jahreszeit)

df_lm_test_WG2_24 <- df_lm_test_WG2 %>%
  mutate(Montag=as.integer(df_lm_test_WG2$Wochentag_c=="Montag")) %>%
  mutate(Dienstag=as.integer(df_lm_test_WG2$Wochentag_c=="Dienstag")) %>%
  mutate(Mittwoch=as.integer(df_lm_test_WG2$Wochentag_c=="Mittwoch")) %>%
  mutate(Donnerstag=as.integer(df_lm_test_WG2$Wochentag_c=="Donnerstag")) %>%
  mutate(Freitag=as.integer(df_lm_test_WG2$Wochentag_c=="Freitag")) %>%
  mutate(Samstag=as.integer(df_lm_test_WG2$Wochentag_c=="Samstag")) %>%
  mutate(Sonntag=as.integer(df_lm_test_WG2$Wochentag_c=="Sonntag")) %>%
  mutate(Januar=as.integer(df_lm_test_WG2$Monat_c=="Januar")) %>%
  mutate(Februar=as.integer(df_lm_test_WG2$Monat_c=="Februar")) %>%
  mutate(Maerz=as.integer(df_lm_test_WG2$Monat_c=="März")) %>%
  mutate(April=as.integer(df_lm_test_WG2$Monat_c=="April")) %>%
  mutate(Mai=as.integer(df_lm_test_WG2$Monat_c=="Mai")) %>%
  mutate(Juni=as.integer(df_lm_test_WG2$Monat_c=="Juni")) %>%
  mutate(Juli=as.integer(df_lm_test_WG2$Monat_c=="Juli")) %>%
  mutate(August=as.integer(df_lm_test_WG2$Monat_c=="August")) %>%
  mutate(September=as.integer(df_lm_test_WG2$Monat_c=="September")) %>%
  mutate(Oktober=as.integer(df_lm_test_WG2$Monat_c=="Oktober")) %>%
  mutate(November=as.integer(df_lm_test_WG2$Monat_c=="November")) %>%
  mutate(Dezember=as.integer(df_lm_test_WG2$Monat_c=="Dezember")) %>%
  mutate(Fruehling=as.integer(df_lm_test_WG2$Jahreszeit=="Fruehling")) %>%
  mutate(Sommer=as.integer(df_lm_test_WG2$Jahreszeit=="Sommer")) %>%
  mutate(Herbst=as.integer(df_lm_test_WG2$Jahreszeit=="Herbst")) %>%
  mutate(Winter=as.integer(df_lm_test_WG2$Jahreszeit=="Winter")) %>%
  dplyr::select(-Wochentag_c, -Monat_c, -Jahreszeit)

Für das 24-Variablenmodell wird nun ein Regressionsmodell erstellt:

## # A tibble: 1 x 11
##   r.squared adj.r.squared sigma statistic p.value    df logLik    AIC
##       <dbl>         <dbl> <dbl>     <dbl>   <dbl> <int>  <dbl>  <dbl>
## 1     0.831         0.828  50.9      222.       0    24 -5663. 11376.
## # ... with 3 more variables: BIC <dbl>, deviance <dbl>, df.residual <int>

Dann wird (die Modellgüte) anhand der Test-Stichprobe getestet:

Als Ergebnis wird ein Vektor erzeugt, der für jede Beobachtung des Test-Samples den geschätzten (vorhergesagten) Umsatzwert speichert. Die Gütewerte lassen sich mit caret::postResample ausgeben:

##       RMSE   Rsquared        MAE 
## 52.0427195  0.8401238 39.7876993

Diese Vorhersage-Ergebnisse werden den Test-Daten hinzugefügt, sodann die Gütekennzahlen berechnet, die wiederum der gemeinsamen Übersichtstabelle für die Gütekennzahlen lm_vgl_kennz hinzugefügt werden:

# Hinzufügen der Ergebnisse
df_lm_test_WG2_24 <- df_lm_test_WG2_24 %>%
  mutate(predicted = lm_WG2_24_predict)

# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
df_lm_test_WG2_24 <- df_lm_test_WG2_24 %>%
  mutate(Prognose_zuhoch = (predicted >= Umsatz)) %>%
  mutate(Abweichung = predicted - Umsatz) %>%
  mutate(Abweichung_abs = abs(predicted - Umsatz)) %>%
  mutate(Abweichung_rel = (predicted - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Ergänze die benötigten Hilfsgrößen
df_lm_test_WG2_24 <-df_lm_test_WG2_24 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- df_lm_test_WG2_24 %>%
  group_by() %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz), 2), Umsatz_mittel = round(sum(Umsatz)/n(), 2), MAE = round(mean(Abweichung_abs), 2), MPE = round(mean(Abweichung_rel)*100, 2), MAPE = round(mean(Abweichung_rel_abs)*100, 2), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100, 2), MSE = round(mean(Abweichung_quad), 2), RMSE = round(sqrt(mean(Abweichung_quad)), 2), rRMSE = round(RMSE/Umsatz_mittel*100, 2))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "best24_WG2")

# füge die Kennzahlen nun an die Vergleichstabelle
lm_vgl_kennz <- rbind(lm_vgl_kennz, temp)
lm_vgl_kennz
## # A tibble: 5 x 11
##   Anzahl Umsatz_ges Umsatz_mittel   MAE   MPE  MAPE  WAPE   MSE  RMSE rRMSE
##    <int>      <dbl>         <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1    346     45738.          132.  24.8 -7.84  18.7  18.8 1067.  32.7  24.7
## 2    346     45738.          132.  24.8 -7.65  18.8  18.8 1064.  32.6  24.7
## 3    346     45738.          132.  24.7 -7.93  18.5  18.7 1050.  32.4  24.5
## 4    346     45738.          132.  24.7 -7.91  18.6  18.7 1050.  32.4  24.5
## 5    346    130413.          377.  39.8  3.37  11.4  10.6 2708.  52.0  13.8
## # ... with 1 more variable: Modell <chr>

Teilmengenauswahl für das 32-Variablen-Modell

Die 32 Variablen sind die folgenden:

  • KielerWoche
  • Bewoelkung
  • Temperatur
  • Windgeschwindigkeit
  • Wochentag_cFreitag
  • Wochentag_cMittwoch
  • Wochentag_cSamstag
  • Wochentag_cSonntag
  • Monat_cAugust
  • Monat_cDezember
  • Monat_cFebruar
  • Monat_cJuli
  • Monat_cJuni
  • Monat_cMai
  • Monat_cNovember
  • Monat_cOktober
  • Monat_cSeptember
  • SommerferienSH
  • SommerferienNRW
  • SommerferienNDS
  • SommerferienHE
  • Feiertag
  • ChristiHimmelfahrt
  • Pfingsten
  • TDE
  • Ostern_ext
  • ChristiHimmelfahrt_ext
  • Pfingsten_ext
  • Silvester_ext
  • JahreszeitHerbst
  • JahreszeitSommer
  • JahreszeitWinter

Die Variablen Wochentag_c, Monat_c und Jahreszeit nun noch dummyfiziert werden (bei Einbeziehung aller Variablen erfolgt die Dummyfizierung automatisch im Rahmen der Regressionsanalyse): Für jeden Wochentag wird eine Variable mit Ausprägung 0/1 gebildet und danach die alte Variable Wochentag_c entfernt. Analog wird bei den beiden anderen Variablen vorgegangen.

# Dummyfizierung der Variablen im Trainigsdatensatz:
df_lm_train_WG2_32 <- df_lm_train_WG2 %>%
  mutate(Montag=as.integer(df_lm_train_WG2$Wochentag_c=="Montag")) %>%
  mutate(Dienstag=as.integer(df_lm_train_WG2$Wochentag_c=="Dienstag")) %>%
  mutate(Mittwoch=as.integer(df_lm_train_WG2$Wochentag_c=="Mittwoch")) %>%
  mutate(Donnerstag=as.integer(df_lm_train_WG2$Wochentag_c=="Donnerstag")) %>%
  mutate(Freitag=as.integer(df_lm_train_WG2$Wochentag_c=="Freitag")) %>%
  mutate(Samstag=as.integer(df_lm_train_WG2$Wochentag_c=="Samstag")) %>%
  mutate(Sonntag=as.integer(df_lm_train_WG2$Wochentag_c=="Sonntag")) %>%
  mutate(Januar=as.integer(df_lm_train_WG2$Monat_c=="Januar")) %>%
  mutate(Februar=as.integer(df_lm_train_WG2$Monat_c=="Februar")) %>%
  mutate(Maerz=as.integer(df_lm_train_WG2$Monat_c=="März")) %>%
  mutate(April=as.integer(df_lm_train_WG2$Monat_c=="April")) %>%
  mutate(Mai=as.integer(df_lm_train_WG2$Monat_c=="Mai")) %>%
  mutate(Juni=as.integer(df_lm_train_WG2$Monat_c=="Juni")) %>%
  mutate(Juli=as.integer(df_lm_train_WG2$Monat_c=="Juli")) %>%
  mutate(August=as.integer(df_lm_train_WG2$Monat_c=="August")) %>%
  mutate(September=as.integer(df_lm_train_WG2$Monat_c=="September")) %>%
  mutate(Oktober=as.integer(df_lm_train_WG2$Monat_c=="Oktober")) %>%
  mutate(November=as.integer(df_lm_train_WG2$Monat_c=="November")) %>%
  mutate(Dezember=as.integer(df_lm_train_WG2$Monat_c=="Dezember")) %>%
  mutate(Fruehling=as.integer(df_lm_train_WG2$Jahreszeit=="Fruehling")) %>%
  mutate(Sommer=as.integer(df_lm_train_WG2$Jahreszeit=="Sommer")) %>%
  mutate(Herbst=as.integer(df_lm_train_WG2$Jahreszeit=="Herbst")) %>%
  mutate(Winter=as.integer(df_lm_train_WG2$Jahreszeit=="Winter")) %>%
  dplyr::select(-Wochentag_c, -Monat_c, -Jahreszeit)

df_lm_test_WG2_32 <- df_lm_test_WG2 %>%
  mutate(Montag=as.integer(df_lm_test_WG2$Wochentag_c=="Montag")) %>%
  mutate(Dienstag=as.integer(df_lm_test_WG2$Wochentag_c=="Dienstag")) %>%
  mutate(Mittwoch=as.integer(df_lm_test_WG2$Wochentag_c=="Mittwoch")) %>%
  mutate(Donnerstag=as.integer(df_lm_test_WG2$Wochentag_c=="Donnerstag")) %>%
  mutate(Freitag=as.integer(df_lm_test_WG2$Wochentag_c=="Freitag")) %>%
  mutate(Samstag=as.integer(df_lm_test_WG2$Wochentag_c=="Samstag")) %>%
  mutate(Sonntag=as.integer(df_lm_test_WG2$Wochentag_c=="Sonntag")) %>%
  mutate(Januar=as.integer(df_lm_test_WG2$Monat_c=="Januar")) %>%
  mutate(Februar=as.integer(df_lm_test_WG2$Monat_c=="Februar")) %>%
  mutate(Maerz=as.integer(df_lm_test_WG2$Monat_c=="März")) %>%
  mutate(April=as.integer(df_lm_test_WG2$Monat_c=="April")) %>%
  mutate(Mai=as.integer(df_lm_test_WG2$Monat_c=="Mai")) %>%
  mutate(Juni=as.integer(df_lm_test_WG2$Monat_c=="Juni")) %>%
  mutate(Juli=as.integer(df_lm_test_WG2$Monat_c=="Juli")) %>%
  mutate(August=as.integer(df_lm_test_WG2$Monat_c=="August")) %>%
  mutate(September=as.integer(df_lm_test_WG2$Monat_c=="September")) %>%
  mutate(Oktober=as.integer(df_lm_test_WG2$Monat_c=="Oktober")) %>%
  mutate(November=as.integer(df_lm_test_WG2$Monat_c=="November")) %>%
  mutate(Dezember=as.integer(df_lm_test_WG2$Monat_c=="Dezember")) %>%
  mutate(Fruehling=as.integer(df_lm_test_WG2$Jahreszeit=="Fruehling")) %>%
  mutate(Sommer=as.integer(df_lm_test_WG2$Jahreszeit=="Sommer")) %>%
  mutate(Herbst=as.integer(df_lm_test_WG2$Jahreszeit=="Herbst")) %>%
  mutate(Winter=as.integer(df_lm_test_WG2$Jahreszeit=="Winter")) %>%
  dplyr::select(-Wochentag_c, -Monat_c, -Jahreszeit)

Für das 32-Variablenmodell wird nun ein Regressionsmodell erstellt:

## # A tibble: 1 x 11
##   r.squared adj.r.squared sigma statistic p.value    df logLik    AIC
##       <dbl>         <dbl> <dbl>     <dbl>   <dbl> <int>  <dbl>  <dbl>
## 1     0.837         0.832  50.3      165.       0    33 -5645. 11358.
## # ... with 3 more variables: BIC <dbl>, deviance <dbl>, df.residual <int>

Dann wird (die Modellgüte) anhand der Test-Stichprobe getestet:

Als Ergebnis wird ein Vektor erzeugt, der für jede Beobachtung des Test-Samples den geschätzten (vorhergesagten) Umsatzwert speichert. Die Gütewerte lassen sich mit caret::postResample ausgeben:

##       RMSE   Rsquared        MAE 
## 52.1755124  0.8391912 39.8508235

Diese Vorhersage-Ergebnisse werden den Test-Daten hinzugefügt, sodann die Gütekennzahlen berechnet, die wiederum der gemeinsamen Übersichtstabelle für die Gütekennzahlen lm_vgl_kennz hinzugefügt werden:

# Hinzufügen der Ergebnisse
df_lm_test_WG2_32 <- df_lm_test_WG2_32 %>%
  mutate(predicted = lm_WG2_32_predict)

# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
df_lm_test_WG2_32 <- df_lm_test_WG2_32 %>%
  mutate(Prognose_zuhoch = (predicted >= Umsatz)) %>%
  mutate(Abweichung = predicted - Umsatz) %>%
  mutate(Abweichung_abs = abs(predicted - Umsatz)) %>%
  mutate(Abweichung_rel = (predicted - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Ergänze die benötigten Hilfsgrößen
df_lm_test_WG2_32 <-df_lm_test_WG2_32 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- df_lm_test_WG2_32 %>%
  group_by() %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz), 2), Umsatz_mittel = round(sum(Umsatz)/n(), 2), MAE = round(mean(Abweichung_abs), 2), MPE = round(mean(Abweichung_rel)*100, 2), MAPE = round(mean(Abweichung_rel_abs)*100, 2), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100, 2), MSE = round(mean(Abweichung_quad), 2), RMSE = round(sqrt(mean(Abweichung_quad)), 2), rRMSE = round(RMSE/Umsatz_mittel*100, 2))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "best32_WG2")

# füge die Kennzahlen nun an die Vergleichstabelle
lm_vgl_kennz <- rbind(lm_vgl_kennz, temp)
lm_vgl_kennz
## # A tibble: 6 x 11
##   Anzahl Umsatz_ges Umsatz_mittel   MAE   MPE  MAPE  WAPE   MSE  RMSE rRMSE
##    <int>      <dbl>         <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1    346     45738.          132.  24.8 -7.84  18.7  18.8 1067.  32.7  24.7
## 2    346     45738.          132.  24.8 -7.65  18.8  18.8 1064.  32.6  24.7
## 3    346     45738.          132.  24.7 -7.93  18.5  18.7 1050.  32.4  24.5
## 4    346     45738.          132.  24.7 -7.91  18.6  18.7 1050.  32.4  24.5
## 5    346    130413.          377.  39.8  3.37  11.4  10.6 2708.  52.0  13.8
## 6    346    130413.          377.  39.8  3.45  11.4  10.6 2722.  52.2  13.8
## # ... with 1 more variable: Modell <chr>

Teilmengenauswahl für die 29-Variablen-Modelle

Die 29 Variablen nach best subset selection sind die folgenden:

  • KielerWoche
  • Bewoelkung
  • Windgeschwindigkeit
  • Wochentag_cFreitag
  • Wochentag_cSamstag
  • Wochentag_cSonntag
  • Monat_cAugust
  • Monat_cDezember
  • Monat_cJuli
  • Monat_cJuni
  • Monat_cMai
  • Monat_cNovember
  • Monat_cOktober
  • Monat_cSeptember
  • SommerferienSH
  • SommerferienNRW
  • SommerferienNDS
  • SommerferienHE
  • Feiertag
  • Ostern_ext
  • ChristiHimmelfahrt_ext
  • Pfingsten_ext
  • Silvester_ext
  • JahreszeitHerbst
  • Wochentag_cMittwoch
  • Monat_cFebruar
  • Ostern
  • JahreszeitSommer
  • JahreszeitWinter

Die Variablen Wochentag_c, Monat und Jahreszeit nun noch dummyfiziert werden (bei Einbeziehung aller Variablen erfolgt die Dummyfizierung automatisch im Rahmen der Regressionsanalyse): Für jeden Wochentag wird eine Variable mit Ausprägung 0/1 gebildet und danach die alte Variable Wochentag_c entfernt. Analog wird bei den beiden anderen Variablen vorgegangen.

# Dummyfizierung der Variablen im Trainigsdatensatz:
df_lm_train_WG2_29 <- df_lm_train_WG2 %>%
  mutate(Montag=as.integer(df_lm_train_WG2$Wochentag_c=="Montag")) %>%
  mutate(Dienstag=as.integer(df_lm_train_WG2$Wochentag_c=="Dienstag")) %>%
  mutate(Mittwoch=as.integer(df_lm_train_WG2$Wochentag_c=="Mittwoch")) %>%
  mutate(Donnerstag=as.integer(df_lm_train_WG2$Wochentag_c=="Donnerstag")) %>%
  mutate(Freitag=as.integer(df_lm_train_WG2$Wochentag_c=="Freitag")) %>%
  mutate(Samstag=as.integer(df_lm_train_WG2$Wochentag_c=="Samstag")) %>%
  mutate(Sonntag=as.integer(df_lm_train_WG2$Wochentag_c=="Sonntag")) %>%
  mutate(Januar=as.integer(df_lm_train_WG2$Monat_c=="Januar")) %>%
  mutate(Februar=as.integer(df_lm_train_WG2$Monat_c=="Februar")) %>%
  mutate(Maerz=as.integer(df_lm_train_WG2$Monat_c=="März")) %>%
  mutate(April=as.integer(df_lm_train_WG2$Monat_c=="April")) %>%
  mutate(Mai=as.integer(df_lm_train_WG2$Monat_c=="Mai")) %>%
  mutate(Juni=as.integer(df_lm_train_WG2$Monat_c=="Juni")) %>%
  mutate(Juli=as.integer(df_lm_train_WG2$Monat_c=="Juli")) %>%
  mutate(August=as.integer(df_lm_train_WG2$Monat_c=="August")) %>%
  mutate(September=as.integer(df_lm_train_WG2$Monat_c=="September")) %>%
  mutate(Oktober=as.integer(df_lm_train_WG2$Monat_c=="Oktober")) %>%
  mutate(November=as.integer(df_lm_train_WG2$Monat_c=="November")) %>%
  mutate(Dezember=as.integer(df_lm_train_WG2$Monat_c=="Dezember")) %>%
  mutate(Fruehling=as.integer(df_lm_train_WG2$Jahreszeit=="Fruehling")) %>%
  mutate(Sommer=as.integer(df_lm_train_WG2$Jahreszeit=="Sommer")) %>%
  mutate(Herbst=as.integer(df_lm_train_WG2$Jahreszeit=="Herbst")) %>%
  mutate(Winter=as.integer(df_lm_train_WG2$Jahreszeit=="Winter")) %>%
  dplyr::select(-Wochentag_c, -Monat_c, -Jahreszeit)

df_lm_test_WG2_29 <- df_lm_test_WG2 %>%
  mutate(Montag=as.integer(df_lm_test_WG2$Wochentag_c=="Montag")) %>%
  mutate(Dienstag=as.integer(df_lm_test_WG2$Wochentag_c=="Dienstag")) %>%
  mutate(Mittwoch=as.integer(df_lm_test_WG2$Wochentag_c=="Mittwoch")) %>%
  mutate(Donnerstag=as.integer(df_lm_test_WG2$Wochentag_c=="Donnerstag")) %>%
  mutate(Freitag=as.integer(df_lm_test_WG2$Wochentag_c=="Freitag")) %>%
  mutate(Samstag=as.integer(df_lm_test_WG2$Wochentag_c=="Samstag")) %>%
  mutate(Sonntag=as.integer(df_lm_test_WG2$Wochentag_c=="Sonntag")) %>%
  mutate(Januar=as.integer(df_lm_test_WG2$Monat_c=="Januar")) %>%
  mutate(Februar=as.integer(df_lm_test_WG2$Monat_c=="Februar")) %>%
  mutate(Maerz=as.integer(df_lm_test_WG2$Monat_c=="März")) %>%
  mutate(April=as.integer(df_lm_test_WG2$Monat_c=="April")) %>%
  mutate(Mai=as.integer(df_lm_test_WG2$Monat_c=="Mai")) %>%
  mutate(Juni=as.integer(df_lm_test_WG2$Monat_c=="Juni")) %>%
  mutate(Juli=as.integer(df_lm_test_WG2$Monat_c=="Juli")) %>%
  mutate(August=as.integer(df_lm_test_WG2$Monat_c=="August")) %>%
  mutate(September=as.integer(df_lm_test_WG2$Monat_c=="September")) %>%
  mutate(Oktober=as.integer(df_lm_test_WG2$Monat_c=="Oktober")) %>%
  mutate(November=as.integer(df_lm_test_WG2$Monat_c=="November")) %>%
  mutate(Dezember=as.integer(df_lm_test_WG2$Monat_c=="Dezember")) %>%
  mutate(Fruehling=as.integer(df_lm_test_WG2$Jahreszeit=="Fruehling")) %>%
  mutate(Sommer=as.integer(df_lm_test_WG2$Jahreszeit=="Sommer")) %>%
  mutate(Herbst=as.integer(df_lm_test_WG2$Jahreszeit=="Herbst")) %>%
  mutate(Winter=as.integer(df_lm_test_WG2$Jahreszeit=="Winter")) %>%
  dplyr::select(-Wochentag_c, -Monat_c, -Jahreszeit)

Für das 29-Variablenmodell nach best subset selection wird nun ein Regressionsmodell erstellt:

## # A tibble: 1 x 11
##   r.squared adj.r.squared sigma statistic p.value    df logLik    AIC
##       <dbl>         <dbl> <dbl>     <dbl>   <dbl> <int>  <dbl>  <dbl>
## 1     0.836         0.832  50.3      182.       0    30 -5647. 11356.
## # ... with 3 more variables: BIC <dbl>, deviance <dbl>, df.residual <int>

Dann wird (die Modellgüte) anhand der Test-Stichprobe getestet:

Als Ergebnis wird ein Vektor erzeugt, der für jede Beobachtung des Test-Samples den geschätzten (vorhergesagten) Umsatzwert speichert. Die Gütewerte lassen sich mit caret::postResample ausgeben:

##       RMSE   Rsquared        MAE 
## 52.6093893  0.8366408 40.2665701

Diese Vorhersage-Ergebnisse werden den Test-Daten hinzugefügt, sodann die Gütekennzahlen berechnet, die wiederum der gemeinsamen Übersichtstabelle für die Gütekennzahlen lm_vgl_kennz hinzugefügt werden:

# Hinzufügen der Ergebnisse
df_lm_test_WG2_29 <- df_lm_test_WG2_29 %>%
  mutate(predicted_bss = lm_WG2_29_predict_bss)

# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
df_lm_test_WG2_29 <- df_lm_test_WG2_29 %>%
  mutate(Prognose_zuhoch = (predicted_bss >= Umsatz)) %>%
  mutate(Abweichung = predicted_bss - Umsatz) %>%
  mutate(Abweichung_abs = abs(predicted_bss - Umsatz)) %>%
  mutate(Abweichung_rel = (predicted_bss - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Ergänze die benötigten Hilfsgrößen
df_lm_test_WG2_29 <-df_lm_test_WG2_29 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- df_lm_test_WG2_29 %>%
  group_by() %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz), 2), Umsatz_mittel = round(sum(Umsatz)/n(), 2), MAE = round(mean(Abweichung_abs), 2), MPE = round(mean(Abweichung_rel)*100, 2), MAPE = round(mean(Abweichung_rel_abs)*100, 2), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100, 2), MSE = round(mean(Abweichung_quad), 2), RMSE = round(sqrt(mean(Abweichung_quad)), 2), rRMSE = round(RMSE/Umsatz_mittel*100, 2))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "best29_bss_WG2")

# füge die Kennzahlen nun an die Vergleichstabelle
lm_vgl_kennz <- rbind(lm_vgl_kennz, temp)
lm_vgl_kennz
## # A tibble: 7 x 11
##   Anzahl Umsatz_ges Umsatz_mittel   MAE   MPE  MAPE  WAPE   MSE  RMSE rRMSE
##    <int>      <dbl>         <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1    346     45738.          132.  24.8 -7.84  18.7  18.8 1067.  32.7  24.7
## 2    346     45738.          132.  24.8 -7.65  18.8  18.8 1064.  32.6  24.7
## 3    346     45738.          132.  24.7 -7.93  18.5  18.7 1050.  32.4  24.5
## 4    346     45738.          132.  24.7 -7.91  18.6  18.7 1050.  32.4  24.5
## 5    346    130413.          377.  39.8  3.37  11.4  10.6 2708.  52.0  13.8
## 6    346    130413.          377.  39.8  3.45  11.4  10.6 2722.  52.2  13.8
## 7    346    130413.          377.  40.3  3.48  11.6  10.7 2768.  52.6  14.0
## # ... with 1 more variable: Modell <chr>

Zum Vergleich wird nun ein Regressionsmodell für das 29-Variablenmodell nach backward selection erstellt:

## # A tibble: 1 x 11
##   r.squared adj.r.squared sigma statistic p.value    df logLik    AIC
##       <dbl>         <dbl> <dbl>     <dbl>   <dbl> <int>  <dbl>  <dbl>
## 1     0.836         0.831  50.3      181.       0    30 -5648. 11358.
## # ... with 3 more variables: BIC <dbl>, deviance <dbl>, df.residual <int>

Dann wird (die Modellgüte) anhand der Test-Stichprobe getestet:

Als Ergebnis wird ein Vektor erzeugt, der für jede Beobachtung des Test-Samples den geschätzten (vorhergesagten) Umsatzwert speichert. Die Gütewerte lassen sich mit caret::postResample ausgeben:

##       RMSE   Rsquared        MAE 
## 52.1542506  0.8394304 39.8687151

Diese Vorhersage-Ergebnisse werden den Test-Daten hinzugefügt, sodann die Gütekennzahlen berechnet, die wiederum der gemeinsamen Übersichtstabelle für die Gütekennzahlen lm_vgl_kennz hinzugefügt werden:

# Hinzufügen der Ergebnisse
df_lm_test_WG2_29 <- df_lm_test_WG2_29 %>%
  mutate(predicted_back = lm_WG2_29_predict_back)

# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
df_lm_test_WG2_29 <- df_lm_test_WG2_29 %>%
  mutate(Prognose_zuhoch = (predicted_back >= Umsatz)) %>%
  mutate(Abweichung = predicted_back - Umsatz) %>%
  mutate(Abweichung_abs = abs(predicted_back - Umsatz)) %>%
  mutate(Abweichung_rel = (predicted_back - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Ergänze die benötigten Hilfsgrößen
df_lm_test_WG2_29 <-df_lm_test_WG2_29 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- df_lm_test_WG2_29 %>%
  group_by() %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz), 2), Umsatz_mittel = round(sum(Umsatz)/n(), 2), MAE = round(mean(Abweichung_abs), 2), MPE = round(mean(Abweichung_rel)*100, 2), MAPE = round(mean(Abweichung_rel_abs)*100, 2), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100, 2), MSE = round(mean(Abweichung_quad), 2), RMSE = round(sqrt(mean(Abweichung_quad)), 2), rRMSE = round(RMSE/Umsatz_mittel*100, 2))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "best29_back_WG2")

# füge die Kennzahlen nun an die Vergleichstabelle
lm_vgl_kennz <- rbind(lm_vgl_kennz, temp)
lm_vgl_kennz
## # A tibble: 8 x 11
##   Anzahl Umsatz_ges Umsatz_mittel   MAE   MPE  MAPE  WAPE   MSE  RMSE rRMSE
##    <int>      <dbl>         <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1    346     45738.          132.  24.8 -7.84  18.7  18.8 1067.  32.7  24.7
## 2    346     45738.          132.  24.8 -7.65  18.8  18.8 1064.  32.6  24.7
## 3    346     45738.          132.  24.7 -7.93  18.5  18.7 1050.  32.4  24.5
## 4    346     45738.          132.  24.7 -7.91  18.6  18.7 1050.  32.4  24.5
## 5    346    130413.          377.  39.8  3.37  11.4  10.6 2708.  52.0  13.8
## 6    346    130413.          377.  39.8  3.45  11.4  10.6 2722.  52.2  13.8
## 7    346    130413.          377.  40.3  3.48  11.6  10.7 2768.  52.6  14.0
## 8    346    130413.          377.  39.9  3.52  11.5  10.6 2720.  52.2  13.8
## # ... with 1 more variable: Modell <chr>

Auch wenn es nur marginale Unterschiede zwischen den Performances der einzelnen Modelle gibt, performt abschließend das 24-Variablen-Modell am besten. da generell schlankere Modelle bevorzugt werden sollten, fällt die Wahl auf das genannte Modell.

Folgende Variablen sind also am besten geeignet, um Prognosen für die Umsätze in der Warengruppe 2 zu erstellen:

  • KielerWoche
  • Temperatur
  • Windgeschwindigkeit
  • Wochentage:
    • Freitag
    • Samstag
    • Sonntag
  • Monate:
    • August
    • Dezember
    • Juli
    • Juni
    • Mai
    • November
    • Oktober
    • September
  • Sommerferien:
    • SH
    • NRW
    • NDS
    • HE
  • Feiertag
  • Ostern_ext
  • ChristiHimmelfahrt_ext
  • Pfingsten_ext
  • Silvester_ext
  • Jahreszeit:
    • Herbst

6.3.3 Warengruppe 3

Erstellung von Trainings- und Testdatensätzen für Warengruppe 3

Auswahl der am besten geeigneten Variablen Was die Vorgehensweise und die enstsprechenden Erläuterungen anbelangt, siehe 6.3.1.

Beste Teilmengenauswahl (“Best subset selection”)

Die regsubsets-Funktion gibt ein Listenobjekt mit vielen Informationen zurück. Zunächst kann der Befehl summary verwendet, um den besten Satz von Variablen für jede Modellgröße zu ermitteln.

## Subset selection object
## Call: regsubsets.formula(Umsatz ~ ., df_lm_train_WG3, nvmax = 37)
## 37 Variables  (and intercept)
##                        Forced in Forced out
## KielerWoche                FALSE      FALSE
## Bewoelkung                 FALSE      FALSE
## Temperatur                 FALSE      FALSE
## Windgeschwindigkeit        FALSE      FALSE
## Wochentag_cDonnerstag      FALSE      FALSE
## Wochentag_cFreitag         FALSE      FALSE
## Wochentag_cMittwoch        FALSE      FALSE
## Wochentag_cMontag          FALSE      FALSE
## Wochentag_cSamstag         FALSE      FALSE
## Wochentag_cSonntag         FALSE      FALSE
## Monat_cAugust              FALSE      FALSE
## Monat_cDezember            FALSE      FALSE
## Monat_cFebruar             FALSE      FALSE
## Monat_cJanuar              FALSE      FALSE
## Monat_cJuli                FALSE      FALSE
## Monat_cJuni                FALSE      FALSE
## Monat_cMai                 FALSE      FALSE
## Monat_cMärz                FALSE      FALSE
## Monat_cNovember            FALSE      FALSE
## Monat_cOktober             FALSE      FALSE
## Monat_cSeptember           FALSE      FALSE
## SommerferienSH             FALSE      FALSE
## SommerferienNRW            FALSE      FALSE
## SommerferienNDS            FALSE      FALSE
## SommerferienHE             FALSE      FALSE
## Feiertag                   FALSE      FALSE
## Ostern                     FALSE      FALSE
## ChristiHimmelfahrt         FALSE      FALSE
## Pfingsten                  FALSE      FALSE
## TDE                        FALSE      FALSE
## Ostern_ext                 FALSE      FALSE
## ChristiHimmelfahrt_ext     FALSE      FALSE
## Pfingsten_ext              FALSE      FALSE
## Silvester_ext              FALSE      FALSE
## JahreszeitHerbst           FALSE      FALSE
## JahreszeitSommer           FALSE      FALSE
## JahreszeitWinter           FALSE      FALSE
## 1 subsets of each size up to 37
## Selection Algorithm: exhaustive
##           KielerWoche Bewoelkung Temperatur Windgeschwindigkeit
## 1  ( 1 )  " "         " "        " "        " "                
## 2  ( 1 )  " "         " "        "*"        " "                
## 3  ( 1 )  " "         " "        "*"        " "                
## 4  ( 1 )  " "         " "        "*"        " "                
## 5  ( 1 )  " "         " "        "*"        " "                
## 6  ( 1 )  " "         " "        "*"        " "                
## 7  ( 1 )  "*"         " "        "*"        " "                
## 8  ( 1 )  "*"         " "        "*"        " "                
## 9  ( 1 )  "*"         " "        "*"        " "                
## 10  ( 1 ) "*"         " "        "*"        " "                
## 11  ( 1 ) "*"         " "        "*"        " "                
## 12  ( 1 ) "*"         " "        "*"        " "                
## 13  ( 1 ) "*"         " "        "*"        " "                
## 14  ( 1 ) "*"         " "        "*"        " "                
## 15  ( 1 ) "*"         " "        "*"        " "                
## 16  ( 1 ) "*"         " "        "*"        " "                
## 17  ( 1 ) "*"         " "        "*"        " "                
## 18  ( 1 ) "*"         " "        "*"        " "                
## 19  ( 1 ) "*"         " "        "*"        " "                
## 20  ( 1 ) "*"         " "        "*"        " "                
## 21  ( 1 ) "*"         "*"        "*"        " "                
## 22  ( 1 ) "*"         " "        "*"        " "                
## 23  ( 1 ) "*"         "*"        "*"        " "                
## 24  ( 1 ) "*"         "*"        "*"        " "                
## 25  ( 1 ) "*"         "*"        "*"        " "                
## 26  ( 1 ) "*"         "*"        " "        " "                
## 27  ( 1 ) "*"         "*"        " "        " "                
## 28  ( 1 ) "*"         "*"        " "        " "                
## 29  ( 1 ) "*"         "*"        " "        " "                
## 30  ( 1 ) "*"         "*"        "*"        " "                
## 31  ( 1 ) "*"         "*"        "*"        " "                
## 32  ( 1 ) "*"         "*"        "*"        "*"                
## 33  ( 1 ) "*"         "*"        "*"        "*"                
## 34  ( 1 ) "*"         "*"        "*"        "*"                
## 35  ( 1 ) "*"         "*"        "*"        "*"                
## 36  ( 1 ) "*"         "*"        "*"        "*"                
## 37  ( 1 ) "*"         "*"        "*"        "*"                
##           Wochentag_cDonnerstag Wochentag_cFreitag Wochentag_cMittwoch
## 1  ( 1 )  " "                   " "                " "                
## 2  ( 1 )  " "                   " "                " "                
## 3  ( 1 )  " "                   " "                " "                
## 4  ( 1 )  " "                   " "                " "                
## 5  ( 1 )  " "                   " "                " "                
## 6  ( 1 )  " "                   " "                " "                
## 7  ( 1 )  " "                   " "                " "                
## 8  ( 1 )  " "                   " "                " "                
## 9  ( 1 )  " "                   " "                " "                
## 10  ( 1 ) " "                   " "                " "                
## 11  ( 1 ) " "                   " "                " "                
## 12  ( 1 ) " "                   " "                " "                
## 13  ( 1 ) " "                   " "                " "                
## 14  ( 1 ) " "                   " "                " "                
## 15  ( 1 ) " "                   " "                " "                
## 16  ( 1 ) " "                   " "                " "                
## 17  ( 1 ) " "                   " "                " "                
## 18  ( 1 ) " "                   " "                " "                
## 19  ( 1 ) " "                   " "                " "                
## 20  ( 1 ) " "                   " "                " "                
## 21  ( 1 ) " "                   " "                " "                
## 22  ( 1 ) " "                   " "                " "                
## 23  ( 1 ) " "                   " "                " "                
## 24  ( 1 ) " "                   "*"                " "                
## 25  ( 1 ) " "                   "*"                " "                
## 26  ( 1 ) " "                   " "                " "                
## 27  ( 1 ) " "                   "*"                " "                
## 28  ( 1 ) " "                   "*"                " "                
## 29  ( 1 ) " "                   "*"                " "                
## 30  ( 1 ) " "                   "*"                " "                
## 31  ( 1 ) " "                   "*"                " "                
## 32  ( 1 ) " "                   "*"                " "                
## 33  ( 1 ) "*"                   "*"                " "                
## 34  ( 1 ) "*"                   "*"                " "                
## 35  ( 1 ) "*"                   "*"                " "                
## 36  ( 1 ) "*"                   "*"                " "                
## 37  ( 1 ) "*"                   "*"                "*"                
##           Wochentag_cMontag Wochentag_cSamstag Wochentag_cSonntag
## 1  ( 1 )  " "               " "                " "               
## 2  ( 1 )  " "               " "                " "               
## 3  ( 1 )  " "               " "                "*"               
## 4  ( 1 )  " "               "*"                "*"               
## 5  ( 1 )  " "               "*"                "*"               
## 6  ( 1 )  " "               "*"                "*"               
## 7  ( 1 )  " "               "*"                "*"               
## 8  ( 1 )  " "               "*"                "*"               
## 9  ( 1 )  " "               "*"                "*"               
## 10  ( 1 ) " "               "*"                "*"               
## 11  ( 1 ) " "               "*"                "*"               
## 12  ( 1 ) " "               "*"                "*"               
## 13  ( 1 ) " "               "*"                "*"               
## 14  ( 1 ) " "               "*"                "*"               
## 15  ( 1 ) " "               "*"                "*"               
## 16  ( 1 ) " "               "*"                "*"               
## 17  ( 1 ) " "               "*"                "*"               
## 18  ( 1 ) " "               "*"                "*"               
## 19  ( 1 ) " "               "*"                "*"               
## 20  ( 1 ) " "               "*"                "*"               
## 21  ( 1 ) " "               "*"                "*"               
## 22  ( 1 ) " "               "*"                "*"               
## 23  ( 1 ) " "               "*"                "*"               
## 24  ( 1 ) " "               "*"                "*"               
## 25  ( 1 ) " "               "*"                "*"               
## 26  ( 1 ) " "               "*"                "*"               
## 27  ( 1 ) " "               "*"                "*"               
## 28  ( 1 ) " "               "*"                "*"               
## 29  ( 1 ) "*"               "*"                "*"               
## 30  ( 1 ) "*"               "*"                "*"               
## 31  ( 1 ) "*"               "*"                "*"               
## 32  ( 1 ) "*"               "*"                "*"               
## 33  ( 1 ) "*"               "*"                "*"               
## 34  ( 1 ) "*"               "*"                "*"               
## 35  ( 1 ) "*"               "*"                "*"               
## 36  ( 1 ) "*"               "*"                "*"               
## 37  ( 1 ) "*"               "*"                "*"               
##           Monat_cAugust Monat_cDezember Monat_cFebruar Monat_cJanuar
## 1  ( 1 )  " "           " "             " "            " "          
## 2  ( 1 )  " "           " "             " "            " "          
## 3  ( 1 )  " "           " "             " "            " "          
## 4  ( 1 )  " "           " "             " "            " "          
## 5  ( 1 )  " "           " "             " "            " "          
## 6  ( 1 )  " "           " "             " "            " "          
## 7  ( 1 )  " "           " "             " "            " "          
## 8  ( 1 )  " "           " "             " "            " "          
## 9  ( 1 )  " "           " "             " "            " "          
## 10  ( 1 ) " "           " "             " "            " "          
## 11  ( 1 ) " "           " "             " "            " "          
## 12  ( 1 ) " "           " "             " "            " "          
## 13  ( 1 ) " "           " "             " "            " "          
## 14  ( 1 ) " "           " "             " "            " "          
## 15  ( 1 ) " "           " "             " "            " "          
## 16  ( 1 ) " "           " "             " "            " "          
## 17  ( 1 ) " "           " "             " "            " "          
## 18  ( 1 ) " "           " "             " "            " "          
## 19  ( 1 ) " "           " "             "*"            "*"          
## 20  ( 1 ) " "           " "             "*"            "*"          
## 21  ( 1 ) " "           " "             "*"            "*"          
## 22  ( 1 ) " "           " "             "*"            " "          
## 23  ( 1 ) " "           " "             "*"            " "          
## 24  ( 1 ) " "           " "             "*"            " "          
## 25  ( 1 ) " "           " "             "*"            "*"          
## 26  ( 1 ) "*"           " "             "*"            "*"          
## 27  ( 1 ) "*"           " "             "*"            "*"          
## 28  ( 1 ) "*"           " "             "*"            "*"          
## 29  ( 1 ) "*"           " "             "*"            "*"          
## 30  ( 1 ) "*"           " "             "*"            "*"          
## 31  ( 1 ) "*"           " "             "*"            "*"          
## 32  ( 1 ) "*"           " "             "*"            "*"          
## 33  ( 1 ) "*"           " "             "*"            "*"          
## 34  ( 1 ) "*"           " "             "*"            "*"          
## 35  ( 1 ) "*"           "*"             "*"            "*"          
## 36  ( 1 ) "*"           "*"             "*"            "*"          
## 37  ( 1 ) "*"           "*"             "*"            "*"          
##           Monat_cJuli Monat_cJuni Monat_cMai Monat_cMärz Monat_cNovember
## 1  ( 1 )  " "         " "         " "        " "         " "            
## 2  ( 1 )  " "         " "         " "        " "         " "            
## 3  ( 1 )  " "         " "         " "        " "         " "            
## 4  ( 1 )  " "         " "         " "        " "         " "            
## 5  ( 1 )  " "         " "         " "        " "         " "            
## 6  ( 1 )  " "         " "         " "        " "         " "            
## 7  ( 1 )  " "         " "         " "        " "         " "            
## 8  ( 1 )  " "         " "         " "        " "         " "            
## 9  ( 1 )  " "         " "         " "        " "         " "            
## 10  ( 1 ) " "         " "         " "        " "         " "            
## 11  ( 1 ) " "         " "         " "        " "         " "            
## 12  ( 1 ) " "         " "         " "        " "         " "            
## 13  ( 1 ) " "         " "         " "        " "         " "            
## 14  ( 1 ) " "         " "         " "        " "         " "            
## 15  ( 1 ) " "         " "         " "        " "         " "            
## 16  ( 1 ) " "         " "         " "        " "         " "            
## 17  ( 1 ) " "         " "         " "        "*"         " "            
## 18  ( 1 ) " "         " "         " "        "*"         " "            
## 19  ( 1 ) " "         " "         " "        "*"         " "            
## 20  ( 1 ) " "         "*"         " "        "*"         " "            
## 21  ( 1 ) " "         "*"         " "        "*"         " "            
## 22  ( 1 ) " "         "*"         " "        "*"         " "            
## 23  ( 1 ) " "         "*"         " "        "*"         " "            
## 24  ( 1 ) " "         "*"         " "        "*"         " "            
## 25  ( 1 ) " "         "*"         " "        "*"         " "            
## 26  ( 1 ) "*"         "*"         "*"        "*"         " "            
## 27  ( 1 ) "*"         "*"         "*"        "*"         " "            
## 28  ( 1 ) "*"         "*"         "*"        "*"         " "            
## 29  ( 1 ) "*"         "*"         "*"        "*"         " "            
## 30  ( 1 ) "*"         "*"         "*"        "*"         " "            
## 31  ( 1 ) "*"         "*"         "*"        "*"         " "            
## 32  ( 1 ) "*"         "*"         "*"        "*"         " "            
## 33  ( 1 ) "*"         "*"         "*"        "*"         " "            
## 34  ( 1 ) "*"         "*"         "*"        "*"         "*"            
## 35  ( 1 ) "*"         "*"         "*"        "*"         "*"            
## 36  ( 1 ) "*"         "*"         "*"        "*"         "*"            
## 37  ( 1 ) "*"         "*"         "*"        "*"         "*"            
##           Monat_cOktober Monat_cSeptember SommerferienSH SommerferienNRW
## 1  ( 1 )  " "            " "              " "            "*"            
## 2  ( 1 )  " "            " "              " "            "*"            
## 3  ( 1 )  " "            " "              " "            "*"            
## 4  ( 1 )  " "            " "              " "            "*"            
## 5  ( 1 )  " "            " "              " "            "*"            
## 6  ( 1 )  " "            " "              " "            "*"            
## 7  ( 1 )  " "            " "              " "            "*"            
## 8  ( 1 )  " "            " "              " "            "*"            
## 9  ( 1 )  " "            " "              "*"            "*"            
## 10  ( 1 ) "*"            " "              "*"            "*"            
## 11  ( 1 ) "*"            " "              "*"            "*"            
## 12  ( 1 ) "*"            " "              "*"            "*"            
## 13  ( 1 ) "*"            " "              "*"            "*"            
## 14  ( 1 ) "*"            " "              "*"            "*"            
## 15  ( 1 ) "*"            " "              "*"            "*"            
## 16  ( 1 ) "*"            "*"              "*"            "*"            
## 17  ( 1 ) "*"            "*"              "*"            "*"            
## 18  ( 1 ) "*"            "*"              "*"            "*"            
## 19  ( 1 ) "*"            "*"              "*"            "*"            
## 20  ( 1 ) "*"            "*"              "*"            "*"            
## 21  ( 1 ) "*"            "*"              "*"            "*"            
## 22  ( 1 ) "*"            "*"              "*"            "*"            
## 23  ( 1 ) "*"            "*"              "*"            "*"            
## 24  ( 1 ) "*"            "*"              "*"            "*"            
## 25  ( 1 ) "*"            "*"              "*"            "*"            
## 26  ( 1 ) "*"            "*"              "*"            "*"            
## 27  ( 1 ) "*"            "*"              "*"            "*"            
## 28  ( 1 ) "*"            "*"              "*"            "*"            
## 29  ( 1 ) "*"            "*"              "*"            "*"            
## 30  ( 1 ) "*"            "*"              "*"            "*"            
## 31  ( 1 ) "*"            "*"              "*"            "*"            
## 32  ( 1 ) "*"            "*"              "*"            "*"            
## 33  ( 1 ) "*"            "*"              "*"            "*"            
## 34  ( 1 ) "*"            "*"              "*"            "*"            
## 35  ( 1 ) "*"            "*"              "*"            "*"            
## 36  ( 1 ) "*"            "*"              "*"            "*"            
## 37  ( 1 ) "*"            "*"              "*"            "*"            
##           SommerferienNDS SommerferienHE Feiertag Ostern
## 1  ( 1 )  " "             " "            " "      " "   
## 2  ( 1 )  " "             " "            " "      " "   
## 3  ( 1 )  " "             " "            " "      " "   
## 4  ( 1 )  " "             " "            " "      " "   
## 5  ( 1 )  " "             "*"            " "      " "   
## 6  ( 1 )  " "             "*"            " "      " "   
## 7  ( 1 )  " "             "*"            " "      " "   
## 8  ( 1 )  " "             "*"            " "      " "   
## 9  ( 1 )  " "             "*"            " "      " "   
## 10  ( 1 ) " "             "*"            " "      " "   
## 11  ( 1 ) " "             "*"            " "      " "   
## 12  ( 1 ) " "             "*"            " "      " "   
## 13  ( 1 ) " "             "*"            " "      " "   
## 14  ( 1 ) " "             "*"            " "      " "   
## 15  ( 1 ) "*"             "*"            " "      " "   
## 16  ( 1 ) "*"             "*"            " "      " "   
## 17  ( 1 ) "*"             "*"            " "      " "   
## 18  ( 1 ) "*"             "*"            " "      " "   
## 19  ( 1 ) "*"             "*"            "*"      "*"   
## 20  ( 1 ) "*"             "*"            "*"      "*"   
## 21  ( 1 ) "*"             "*"            "*"      "*"   
## 22  ( 1 ) "*"             "*"            " "      "*"   
## 23  ( 1 ) "*"             "*"            " "      "*"   
## 24  ( 1 ) "*"             "*"            " "      "*"   
## 25  ( 1 ) "*"             "*"            " "      "*"   
## 26  ( 1 ) "*"             "*"            " "      "*"   
## 27  ( 1 ) "*"             "*"            " "      "*"   
## 28  ( 1 ) "*"             "*"            " "      "*"   
## 29  ( 1 ) "*"             "*"            " "      "*"   
## 30  ( 1 ) "*"             "*"            " "      "*"   
## 31  ( 1 ) "*"             "*"            " "      "*"   
## 32  ( 1 ) "*"             "*"            " "      "*"   
## 33  ( 1 ) "*"             "*"            " "      "*"   
## 34  ( 1 ) "*"             "*"            " "      "*"   
## 35  ( 1 ) "*"             "*"            " "      "*"   
## 36  ( 1 ) "*"             "*"            "*"      "*"   
## 37  ( 1 ) "*"             "*"            "*"      "*"   
##           ChristiHimmelfahrt Pfingsten TDE Ostern_ext
## 1  ( 1 )  " "                " "       " " " "       
## 2  ( 1 )  " "                " "       " " " "       
## 3  ( 1 )  " "                " "       " " " "       
## 4  ( 1 )  " "                " "       " " " "       
## 5  ( 1 )  " "                " "       " " " "       
## 6  ( 1 )  " "                " "       " " "*"       
## 7  ( 1 )  " "                " "       " " "*"       
## 8  ( 1 )  " "                "*"       " " "*"       
## 9  ( 1 )  " "                "*"       " " "*"       
## 10  ( 1 ) " "                "*"       " " "*"       
## 11  ( 1 ) " "                "*"       " " "*"       
## 12  ( 1 ) " "                "*"       " " "*"       
## 13  ( 1 ) " "                "*"       " " "*"       
## 14  ( 1 ) " "                "*"       " " "*"       
## 15  ( 1 ) " "                "*"       " " "*"       
## 16  ( 1 ) " "                "*"       " " "*"       
## 17  ( 1 ) " "                "*"       " " "*"       
## 18  ( 1 ) " "                "*"       " " "*"       
## 19  ( 1 ) " "                " "       " " "*"       
## 20  ( 1 ) " "                " "       " " "*"       
## 21  ( 1 ) " "                " "       " " "*"       
## 22  ( 1 ) " "                "*"       "*" "*"       
## 23  ( 1 ) " "                "*"       "*" "*"       
## 24  ( 1 ) " "                "*"       "*" "*"       
## 25  ( 1 ) " "                "*"       "*" "*"       
## 26  ( 1 ) " "                "*"       "*" "*"       
## 27  ( 1 ) " "                "*"       "*" "*"       
## 28  ( 1 ) " "                "*"       "*" "*"       
## 29  ( 1 ) " "                "*"       "*" "*"       
## 30  ( 1 ) " "                "*"       "*" "*"       
## 31  ( 1 ) "*"                "*"       "*" "*"       
## 32  ( 1 ) "*"                "*"       "*" "*"       
## 33  ( 1 ) "*"                "*"       "*" "*"       
## 34  ( 1 ) "*"                "*"       "*" "*"       
## 35  ( 1 ) "*"                "*"       "*" "*"       
## 36  ( 1 ) "*"                "*"       "*" "*"       
## 37  ( 1 ) "*"                "*"       "*" "*"       
##           ChristiHimmelfahrt_ext Pfingsten_ext Silvester_ext
## 1  ( 1 )  " "                    " "           " "          
## 2  ( 1 )  " "                    " "           " "          
## 3  ( 1 )  " "                    " "           " "          
## 4  ( 1 )  " "                    " "           " "          
## 5  ( 1 )  " "                    " "           " "          
## 6  ( 1 )  " "                    " "           " "          
## 7  ( 1 )  " "                    " "           " "          
## 8  ( 1 )  " "                    " "           " "          
## 9  ( 1 )  " "                    " "           " "          
## 10  ( 1 ) " "                    " "           " "          
## 11  ( 1 ) " "                    " "           " "          
## 12  ( 1 ) "*"                    " "           " "          
## 13  ( 1 ) "*"                    " "           " "          
## 14  ( 1 ) "*"                    " "           "*"          
## 15  ( 1 ) "*"                    " "           "*"          
## 16  ( 1 ) "*"                    " "           "*"          
## 17  ( 1 ) "*"                    " "           "*"          
## 18  ( 1 ) "*"                    "*"           "*"          
## 19  ( 1 ) "*"                    "*"           " "          
## 20  ( 1 ) "*"                    "*"           " "          
## 21  ( 1 ) "*"                    "*"           " "          
## 22  ( 1 ) "*"                    "*"           "*"          
## 23  ( 1 ) "*"                    "*"           "*"          
## 24  ( 1 ) "*"                    "*"           "*"          
## 25  ( 1 ) "*"                    "*"           "*"          
## 26  ( 1 ) "*"                    "*"           "*"          
## 27  ( 1 ) "*"                    "*"           "*"          
## 28  ( 1 ) "*"                    "*"           "*"          
## 29  ( 1 ) "*"                    "*"           "*"          
## 30  ( 1 ) "*"                    "*"           "*"          
## 31  ( 1 ) "*"                    "*"           "*"          
## 32  ( 1 ) "*"                    "*"           "*"          
## 33  ( 1 ) "*"                    "*"           "*"          
## 34  ( 1 ) "*"                    "*"           "*"          
## 35  ( 1 ) "*"                    "*"           "*"          
## 36  ( 1 ) "*"                    "*"           "*"          
## 37  ( 1 ) "*"                    "*"           "*"          
##           JahreszeitHerbst JahreszeitSommer JahreszeitWinter
## 1  ( 1 )  " "              " "              " "             
## 2  ( 1 )  " "              " "              " "             
## 3  ( 1 )  " "              " "              " "             
## 4  ( 1 )  " "              " "              " "             
## 5  ( 1 )  " "              " "              " "             
## 6  ( 1 )  " "              " "              " "             
## 7  ( 1 )  " "              " "              " "             
## 8  ( 1 )  " "              " "              " "             
## 9  ( 1 )  " "              " "              " "             
## 10  ( 1 ) " "              " "              " "             
## 11  ( 1 ) "*"              " "              " "             
## 12  ( 1 ) "*"              " "              " "             
## 13  ( 1 ) "*"              " "              "*"             
## 14  ( 1 ) "*"              " "              "*"             
## 15  ( 1 ) "*"              " "              "*"             
## 16  ( 1 ) "*"              " "              "*"             
## 17  ( 1 ) "*"              " "              "*"             
## 18  ( 1 ) "*"              " "              "*"             
## 19  ( 1 ) "*"              " "              " "             
## 20  ( 1 ) "*"              " "              " "             
## 21  ( 1 ) "*"              " "              " "             
## 22  ( 1 ) "*"              " "              "*"             
## 23  ( 1 ) "*"              " "              "*"             
## 24  ( 1 ) "*"              " "              "*"             
## 25  ( 1 ) "*"              " "              "*"             
## 26  ( 1 ) "*"              " "              "*"             
## 27  ( 1 ) "*"              " "              "*"             
## 28  ( 1 ) "*"              "*"              "*"             
## 29  ( 1 ) "*"              "*"              "*"             
## 30  ( 1 ) "*"              "*"              "*"             
## 31  ( 1 ) "*"              "*"              "*"             
## 32  ( 1 ) "*"              "*"              "*"             
## 33  ( 1 ) "*"              "*"              "*"             
## 34  ( 1 ) "*"              "*"              "*"             
## 35  ( 1 ) "*"              "*"              "*"             
## 36  ( 1 ) "*"              "*"              "*"             
## 37  ( 1 ) "*"              "*"              "*"

Für ein Modell mit einer Variablen kann beobachtet werden, dass die erzeugte Dummy-Variable SommerferienNRW ein Sternchen hat, was signalisiert, dass ein Regressionsmodell mit Umsatz ~ SommerferienNRW das beste Einzelvariablenmodell ist. Das beste 2-Variablen-Modell ist Umsatz ~ SommerferienNRW + Temperatur. Das beste 3-Variablen-Modell ist Umsatz ~ SommerferienNRW + Temperatur + Wochentag_cSonntag. Beim 4-Variablen-Modell wird der Wochentag_cSamstag hinzugefügt.

Modellauswahl

Indirekte Schätzung des Testfehlers mit \(C_{p}\), \(AIC\), \(BIC\) und adjustiertem \(R^2\)

## [1] 30
## [1] 20
## [1] 28

Es ist erkennbar, dass die Ergebnisse leicht unterschiedliche Modelle identifizieren, die als die besten angesehen werden. Die ajustierte \(R^2\)-Statistik legt nahe, dass das 30-Variablen-Modell bevorzugt wird, die \(BIC\)-Statistik schlägt das 20-Variablenmodell vor und der \(C_{p}\) das 28-Variablen-Modell vor.

Der gleiche Prozess kann durch schrittweise Vorwärts- und Rückwärtsauswahl durchgeführt werden, um noch mehr Optionen für optimale Modelle zu erhalten:

## [1] 29
## [1] 28

Wenn man das optimale \(C_{p}\) für vorwärts und rückwärts schrittweise bewertet, ist erkennbar, dass gemäß der Vorwärts-Methode ein 29-Variablen-Modell die \(C_{p}\)-Statistik minimiert. Die Rückwärtsmethode schlägt ein 28-Variablen-Modell vor.

Wenn wir die Koeffizienten dieser Modelle bewerten, ergibt sich bzgl. der Zusammensetzung der Prädikatoren folgendes Bild:

##            (Intercept)            KielerWoche             Temperatur 
##            106.0471994             47.6753392              0.9400878 
##     Wochentag_cSamstag     Wochentag_cSonntag         Monat_cFebruar 
##             48.3118671             54.7014514            -22.9256947 
##          Monat_cJanuar            Monat_cJuni            Monat_cMärz 
##            -15.9842631             11.5002351            -20.2984903 
##         Monat_cOktober       Monat_cSeptember         SommerferienSH 
##             44.3266560             16.4473488             39.4563302 
##        SommerferienNRW        SommerferienNDS         SommerferienHE 
##             60.8392704             17.8177016             45.6218462 
##               Feiertag                 Ostern             Ostern_ext 
##             39.5942375            -80.4956376            126.1742444 
## ChristiHimmelfahrt_ext          Pfingsten_ext       JahreszeitHerbst 
##             49.1599377             45.9086916            -27.2939939

Folgende Variablen werden in das 20-Variablen-Modell integriert:

  • KielerWoche
  • Temperatur
  • Wochentag_cSamstag
  • Wochentag_cSonntag
  • Monat_cFebruar
  • Monat_cJanuar
  • Monat_cJuni
  • Monat_cMärz
  • Monat_cOktober
  • Monat_cSeptember
  • SommerferienSH
  • SommerferienNRW
  • SommerferienNDS
  • SommerferienHE
  • Feiertag
  • Ostern
  • Ostern_ext
  • ChristiHimmelfahrt_ext
  • Pfingsten_ext
  • JahreszeitHerbst
##            (Intercept)            KielerWoche             Bewoelkung 
##            117.2396203             53.6097207             -0.9290962 
##     Wochentag_cFreitag     Wochentag_cSamstag     Wochentag_cSonntag 
##              4.2772419             48.6671722             54.8805645 
##          Monat_cAugust         Monat_cFebruar          Monat_cJanuar 
##             25.6249105            -16.9913859            -11.3979256 
##            Monat_cJuli            Monat_cJuni             Monat_cMai 
##             27.0553148             22.5209100              8.6528684 
##            Monat_cMärz         Monat_cOktober       Monat_cSeptember 
##            -14.9778010             49.9197054             31.3776962 
##         SommerferienSH        SommerferienNRW        SommerferienNDS 
##             37.7613398             56.7176167             16.5848019 
##         SommerferienHE                 Ostern              Pfingsten 
##             44.0127943            -40.7850255             58.1798104 
##                    TDE             Ostern_ext ChristiHimmelfahrt_ext 
##             45.2020603            125.2800213             54.4629528 
##          Pfingsten_ext          Silvester_ext       JahreszeitHerbst 
##             34.0208217             42.9623673            -28.7913280 
##       JahreszeitSommer       JahreszeitWinter 
##             -8.3757382             -8.7783715

Beim 28-Variablen-Modell werden folgende Variablen aufgenommen:

  • KielerWoche
  • Bewoelkung
  • Wochentag_cFreitag
  • Wochentag_cSamstag
  • Wochentag_cSonntag
  • Monat_cAugust
  • Monat_cFebruar
  • Monat_cJanuar
  • Monat_cJuli
  • Monat_cJuni
  • Monat_cMai
  • Monat_cMärz
  • Monat_cOktober
  • Monat_cSeptember
  • SommerferienSH
  • SommerferienNRW
  • SommerferienNDS
  • SommerferienHE
  • Ostern
  • Pfingsten
  • TDE
  • Ostern_ext
  • ChristiHimmelfahrt_ext
  • Pfingsten_ext
  • Silvester_ext
  • JahreszeitHerbst
  • JahreszeitSommer
  • JahreszeitWinter
##            (Intercept)            KielerWoche             Bewoelkung 
##            112.1340426             52.9972328             -0.7861647 
##             Temperatur     Wochentag_cFreitag      Wochentag_cMontag 
##              0.3622229              5.1432788              3.6969705 
##     Wochentag_cSamstag     Wochentag_cSonntag          Monat_cAugust 
##             49.5722868             55.8128039             21.7290071 
##         Monat_cFebruar          Monat_cJanuar            Monat_cJuli 
##            -16.2297545            -10.1105643             23.4708693 
##            Monat_cJuni             Monat_cMai            Monat_cMärz 
##             19.5138212              6.6355873            -14.9282982 
##         Monat_cOktober       Monat_cSeptember         SommerferienSH 
##             48.0702081             28.1323766             37.9685573 
##        SommerferienNRW        SommerferienNDS         SommerferienHE 
##             56.4189768             16.2955412             43.9650470 
##                 Ostern              Pfingsten                    TDE 
##            -42.6545012             56.6706858             43.7846082 
##             Ostern_ext ChristiHimmelfahrt_ext          Pfingsten_ext 
##            126.2327204             54.5661728             34.9534977 
##          Silvester_ext       JahreszeitHerbst       JahreszeitSommer 
##             43.7544943            -27.8237783             -8.0168561 
##       JahreszeitWinter 
##             -7.5948847

Im 30-Variablen-Modell werden die beiden Variablen Temperatur und Wochentag_cMontag ergänzt.

##            (Intercept)            KielerWoche             Bewoelkung 
##            113.0039067             53.0429430             -0.7884231 
##             Temperatur     Wochentag_cFreitag     Wochentag_cSamstag 
##              0.3609494              4.2571491             48.6956381 
##     Wochentag_cSonntag          Monat_cAugust         Monat_cFebruar 
##             54.8641906             21.8432355            -15.9167225 
##          Monat_cJanuar            Monat_cJuli            Monat_cJuni 
##             -9.8121360             23.5284206             19.5390215 
##             Monat_cMai            Monat_cMärz         Monat_cOktober 
##              6.7356599            -14.7731313             48.0705731 
##       Monat_cSeptember         SommerferienSH        SommerferienNRW 
##             28.1774605             37.9294906             56.4839249 
##        SommerferienNDS         SommerferienHE                 Ostern 
##             16.3676873             43.8671201            -40.8766030 
##              Pfingsten                    TDE             Ostern_ext 
##             58.5509859             44.4065768            125.8774918 
## ChristiHimmelfahrt_ext          Pfingsten_ext          Silvester_ext 
##             54.1656236             34.4787097             43.7198145 
##       JahreszeitHerbst       JahreszeitSommer       JahreszeitWinter 
##            -27.7626016             -8.0340646             -7.8114667
##            (Intercept)            KielerWoche             Bewoelkung 
##            117.2396204             53.6097206             -0.9290962 
##     Wochentag_cFreitag     Wochentag_cSamstag     Wochentag_cSonntag 
##              4.2772419             48.6671722             54.8805645 
##          Monat_cAugust         Monat_cFebruar          Monat_cJanuar 
##             25.6249105            -16.9913859            -11.3979257 
##            Monat_cJuli            Monat_cJuni             Monat_cMai 
##             27.0553148             22.5209100              8.6528684 
##            Monat_cMärz         Monat_cOktober       Monat_cSeptember 
##            -14.9778010             49.9197054             31.3776961 
##         SommerferienSH        SommerferienNRW        SommerferienNDS 
##             37.7613398             56.7176166             16.5848019 
##         SommerferienHE                 Ostern              Pfingsten 
##             44.0127943            -40.7850253             58.1798102 
##                    TDE             Ostern_ext ChristiHimmelfahrt_ext 
##             45.2020604            125.2800212             54.4629528 
##          Pfingsten_ext          Silvester_ext       JahreszeitHerbst 
##             34.0208217             42.9623672            -28.7913280 
##       JahreszeitSommer       JahreszeitWinter 
##             -8.3757382             -8.7783715

Die Modelle unterscheiden sich nur marginal von denen der best subset selection.

Direkte Schätzung des Testfehlers

Nun wird der Fehler der Testdaten für das beste Modell jeder Modellgröße berechnet. Zuerst wird eine Modellmatrix aus den Testdaten erstellt. Die Funktion model.matrix wird in vielen Regressionspaketen zum Erstellen einer X-Matrix aus Daten verwendet.

Jetzt kann jede Modellgröße (d.h. 1 Variable, 2 Variablen,…, 20 Variablen) durchlaufen werden und die Koeffizienten für das beste Modell dieser Größe extrahiert werden. Diese Werte werden sodann in die entsprechenden Spalten der Testmodellmatrix multipliziert, um die Vorhersagen zu bilden. Dann werden die Test-MSE berechnet.

##           [,1]
##  [1,] 4348.738
##  [2,] 3376.739
##  [3,] 2718.970
##  [4,] 2228.789
##  [5,] 2193.722
##  [6,] 2066.863
##  [7,] 2015.831
##  [8,] 2014.283
##  [9,] 1857.352
## [10,] 1821.443
## [11,] 1852.143
## [12,] 1805.983
## [13,] 1836.865
## [14,] 1785.291
## [15,] 1757.158
## [16,] 1770.338
## [17,] 1788.553
## [18,] 1778.665
## [19,] 1733.495
## [20,] 1753.647
## [21,] 1744.054
## [22,] 1760.097
## [23,] 1751.844
## [24,] 1742.633
## [25,] 1733.022
## [26,] 1749.919
## [27,] 1740.599
## [28,] 1737.503
## [29,] 1739.846
## [30,] 1722.270
## [31,] 1721.400
## [32,] 1720.616
## [33,] 1723.854
## [34,] 1722.438
## [35,] 1716.123
## [36,] 1715.292
## [37,] 1715.364

Es ist erkennbar, dass ein 21-Variablen-Modell, das durch den besten Teilmengenansatz erzeugt wird, den niedrigsten Test-MSE erzeugt. Auch ein 10- bzw. 12-Variablen-Modell scheinen vergleichweichsweise gut zu performen.

Wir können jetzt die beste Teilmengenauswahl für den gesamten Datensatz durchführen, um zum einen das 20-Variablen-Modell zu erhalten. Dieses Modell wird mit den 30-Variablen-Modellen nach Best subset selection verglichen.

Teilmengenauswahl für das 20-Variablen-Modell

Die 20 Variablen sind die folgenden:

  • KielerWoche
  • Temperatur
  • Wochentag_cSamstag
  • Wochentag_cSonntag
  • Monat_cFebruar
  • Monat_cJanuar
  • Monat_cJuni
  • Monat_cMärz
  • Monat_cOktober
  • Monat_cSeptember
  • SommerferienSH
  • SommerferienNRW
  • SommerferienNDS
  • SommerferienHE
  • Feiertag
  • Ostern
  • Ostern_ext
  • ChristiHimmelfahrt_ext
  • Pfingsten_ext
  • JahreszeitHerbst

Die Variablen Wochentag_c, Monat und Jahreszeit müssen noch dummyfiziert werden (bei Einbeziehung aller Variablen erfolgt die Dummyfizierung automatisch im Rahmen der Regressionsanalyse): Für jeden Wochentag wird eine Variable mit Ausprägung 0/1 gebildet und danach die alte Variable Wochentag_c entfernt. Analog wird bei den beiden anderen Variablen vorgegangen.

# Dummyfizierung der Variablen im Trainigsdatensatz:
df_lm_train_WG3_20 <- df_lm_train_WG3 %>%
  mutate(Montag=as.integer(df_lm_train_WG3$Wochentag_c=="Montag")) %>%
  mutate(Dienstag=as.integer(df_lm_train_WG3$Wochentag_c=="Dienstag")) %>%
  mutate(Mittwoch=as.integer(df_lm_train_WG3$Wochentag_c=="Mittwoch")) %>%
  mutate(Donnerstag=as.integer(df_lm_train_WG3$Wochentag_c=="Donnerstag")) %>%
  mutate(Freitag=as.integer(df_lm_train_WG3$Wochentag_c=="Freitag")) %>%
  mutate(Samstag=as.integer(df_lm_train_WG3$Wochentag_c=="Samstag")) %>%
  mutate(Sonntag=as.integer(df_lm_train_WG3$Wochentag_c=="Sonntag")) %>%
  mutate(Januar=as.integer(df_lm_train_WG3$Monat_c=="Januar")) %>%
  mutate(Februar=as.integer(df_lm_train_WG3$Monat_c=="Februar")) %>%
  mutate(Maerz=as.integer(df_lm_train_WG3$Monat_c=="März")) %>%
  mutate(April=as.integer(df_lm_train_WG3$Monat_c=="April")) %>%
  mutate(Mai=as.integer(df_lm_train_WG3$Monat_c=="Mai")) %>%
  mutate(Juni=as.integer(df_lm_train_WG3$Monat_c=="Juni")) %>%
  mutate(Juli=as.integer(df_lm_train_WG3$Monat_c=="Juli")) %>%
  mutate(August=as.integer(df_lm_train_WG3$Monat_c=="August")) %>%
  mutate(September=as.integer(df_lm_train_WG3$Monat_c=="September")) %>%
  mutate(Oktober=as.integer(df_lm_train_WG3$Monat_c=="Oktober")) %>%
  mutate(November=as.integer(df_lm_train_WG3$Monat_c=="November")) %>%
  mutate(Dezember=as.integer(df_lm_train_WG3$Monat_c=="Dezember")) %>%
  mutate(Fruehling=as.integer(df_lm_train_WG3$Jahreszeit=="Fruehling")) %>%
  mutate(Sommer=as.integer(df_lm_train_WG3$Jahreszeit=="Sommer")) %>%
  mutate(Herbst=as.integer(df_lm_train_WG3$Jahreszeit=="Herbst")) %>%
  mutate(Winter=as.integer(df_lm_train_WG3$Jahreszeit=="Winter")) %>%
  dplyr::select(-Wochentag_c, -Monat_c, -Jahreszeit)

df_lm_test_WG3_20 <- df_lm_test_WG3 %>%
  mutate(Montag=as.integer(df_lm_test_WG3$Wochentag_c=="Montag")) %>%
  mutate(Dienstag=as.integer(df_lm_test_WG3$Wochentag_c=="Dienstag")) %>%
  mutate(Mittwoch=as.integer(df_lm_test_WG3$Wochentag_c=="Mittwoch")) %>%
  mutate(Donnerstag=as.integer(df_lm_test_WG3$Wochentag_c=="Donnerstag")) %>%
  mutate(Freitag=as.integer(df_lm_test_WG3$Wochentag_c=="Freitag")) %>%
  mutate(Samstag=as.integer(df_lm_test_WG3$Wochentag_c=="Samstag")) %>%
  mutate(Sonntag=as.integer(df_lm_test_WG3$Wochentag_c=="Sonntag")) %>%
  mutate(Januar=as.integer(df_lm_test_WG3$Monat_c=="Januar")) %>%
  mutate(Februar=as.integer(df_lm_test_WG3$Monat_c=="Februar")) %>%
  mutate(Maerz=as.integer(df_lm_test_WG3$Monat_c=="März")) %>%
  mutate(April=as.integer(df_lm_test_WG3$Monat_c=="April")) %>%
  mutate(Mai=as.integer(df_lm_test_WG3$Monat_c=="Mai")) %>%
  mutate(Juni=as.integer(df_lm_test_WG3$Monat_c=="Juni")) %>%
  mutate(Juli=as.integer(df_lm_test_WG3$Monat_c=="Juli")) %>%
  mutate(August=as.integer(df_lm_test_WG3$Monat_c=="August")) %>%
  mutate(September=as.integer(df_lm_test_WG3$Monat_c=="September")) %>%
  mutate(Oktober=as.integer(df_lm_test_WG3$Monat_c=="Oktober")) %>%
  mutate(November=as.integer(df_lm_test_WG3$Monat_c=="November")) %>%
  mutate(Dezember=as.integer(df_lm_test_WG3$Monat_c=="Dezember")) %>%
  mutate(Fruehling=as.integer(df_lm_test_WG2$Jahreszeit=="Fruehling")) %>%
  mutate(Sommer=as.integer(df_lm_test_WG3$Jahreszeit=="Sommer")) %>%
  mutate(Herbst=as.integer(df_lm_test_WG3$Jahreszeit=="Herbst")) %>%
  mutate(Winter=as.integer(df_lm_test_WG3$Jahreszeit=="Winter")) %>%
  dplyr::select(-Wochentag_c, -Monat_c, -Jahreszeit)

Für das 20-Variablenmodell wird nun ein Regressionsmodell erstellt:

## # A tibble: 1 x 11
##   r.squared adj.r.squared sigma statistic p.value    df logLik    AIC
##       <dbl>         <dbl> <dbl>     <dbl>   <dbl> <int>  <dbl>  <dbl>
## 1     0.816         0.812  28.8      210.       0    23 -5059. 10167.
## # ... with 3 more variables: BIC <dbl>, deviance <dbl>, df.residual <int>

Dann wird (die Modellgüte) anhand der Test-Stichprobe getestet:

Als Ergebnis wird ein Vektor erzeugt, der für jede Beobachtung des Test-Samples den geschätzten (vorhergesagten) Umsatzwert speichert. Die Gütewerte lassen sich mit caret::postResample ausgeben:

##       RMSE   Rsquared        MAE 
## 41.8412802  0.8374625 31.1965855

Diese Vorhersage-Ergebnisse werden den Test-Daten hinzugefügt, sodann die Gütekennzahlen berechnet, die wiederum der gemeinsamen Übersichtstabelle für die Gütekennzahlen lm_vgl_kennz hinzugefügt werden:

# Hinzufügen der Ergebnisse
df_lm_test_WG3_20 <- df_lm_test_WG3_20 %>%
  mutate(predicted = lm_WG3_20_predict)

# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
df_lm_test_WG3_20 <- df_lm_test_WG3_20 %>%
  mutate(Prognose_zuhoch = (predicted >= Umsatz)) %>%
  mutate(Abweichung = predicted - Umsatz) %>%
  mutate(Abweichung_abs = abs(predicted - Umsatz)) %>%
  mutate(Abweichung_rel = (predicted - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Ergänze die benötigten Hilfsgrößen
df_lm_test_WG3_20 <-df_lm_test_WG3_20 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- df_lm_test_WG3_20 %>%
  group_by() %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz), 2), Umsatz_mittel = round(sum(Umsatz)/n(), 2), MAE = round(mean(Abweichung_abs), 2), MPE = round(mean(Abweichung_rel)*100, 2), MAPE = round(mean(Abweichung_rel_abs)*100, 2), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100, 2), MSE = round(mean(Abweichung_quad), 2), RMSE = round(sqrt(mean(Abweichung_quad)), 2), rRMSE = round(RMSE/Umsatz_mittel*100, 2))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "best20_WG3")

# füge die Kennzahlen nun an die Vergleichstabelle
lm_vgl_kennz <- rbind(lm_vgl_kennz, temp)
lm_vgl_kennz
## # A tibble: 9 x 11
##   Anzahl Umsatz_ges Umsatz_mittel   MAE   MPE  MAPE  WAPE   MSE  RMSE rRMSE
##    <int>      <dbl>         <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1    346     45738.          132.  24.8 -7.84  18.7  18.8 1067.  32.7  24.7
## 2    346     45738.          132.  24.8 -7.65  18.8  18.8 1064.  32.6  24.7
## 3    346     45738.          132.  24.7 -7.93  18.5  18.7 1050.  32.4  24.5
## 4    346     45738.          132.  24.7 -7.91  18.6  18.7 1050.  32.4  24.5
## 5    346    130413.          377.  39.8  3.37  11.4  10.6 2708.  52.0  13.8
## 6    346    130413.          377.  39.8  3.45  11.4  10.6 2722.  52.2  13.8
## 7    346    130413.          377.  40.3  3.48  11.6  10.7 2768.  52.6  14.0
## 8    346    130413.          377.  39.9  3.52  11.5  10.6 2720.  52.2  13.8
## 9    346     59316.          171.  31.2 -8.4   17.3  18.2 1751.  41.8  24.4
## # ... with 1 more variable: Modell <chr>

Teilmengenauswahl für das 30-Variablen-Modell

Die 30 Variablen sind die folgenden:

  • KielerWoche
  • Temperatur
  • Bewoelkung
  • Wochentag_cFreitag
  • Wochentag_cMonatg
  • Wochentag_cSamstag
  • Wochentag_cSonntag
  • Monat_cAugust
  • Monat_cFebruar
  • Monat_cJanuar
  • Monat_cJuli
  • Monat_cJuni
  • Monat_cMai
  • Monat_cMärz
  • Monat_cOktober
  • Monat_cSeptember
  • SommerferienSH
  • SommerferienNRW
  • SommerferienNDS
  • SommerferienHE
  • Ostern
  • Pfingsten
  • TDE
  • Ostern_ext
  • ChristiHimmelfahrt_ext
  • Pfingsten_ext
  • Silvester_ext
  • JahreszeitHerbst
  • JahreszeitSommer
  • JahreszeitWinter

Die Variablen Wochentag_c, Monat_c und Jahreszeit nun noch dummyfiziert werden (bei Einbeziehung aller Variablen erfolgt die Dummyfizierung automatisch im Rahmen der Regressionsanalyse): Für jeden Wochentag wird eine Variable mit Ausprägung 0/1 gebildet und danach die alte Variable Wochentag_c entfernt. Analog wird bei den beiden anderen Variablen vorgegangen.

# Dummyfizierung der Variablen im Trainigsdatensatz:
df_lm_train_WG3_30 <- df_lm_train_WG3 %>%
  mutate(Montag=as.integer(df_lm_train_WG3$Wochentag_c=="Montag")) %>%
  mutate(Dienstag=as.integer(df_lm_train_WG3$Wochentag_c=="Dienstag")) %>%
  mutate(Mittwoch=as.integer(df_lm_train_WG3$Wochentag_c=="Mittwoch")) %>%
  mutate(Donnerstag=as.integer(df_lm_train_WG3$Wochentag_c=="Donnerstag")) %>%
  mutate(Freitag=as.integer(df_lm_train_WG3$Wochentag_c=="Freitag")) %>%
  mutate(Samstag=as.integer(df_lm_train_WG3$Wochentag_c=="Samstag")) %>%
  mutate(Sonntag=as.integer(df_lm_train_WG3$Wochentag_c=="Sonntag")) %>%
  mutate(Januar=as.integer(df_lm_train_WG3$Monat_c=="Januar")) %>%
  mutate(Februar=as.integer(df_lm_train_WG3$Monat_c=="Februar")) %>%
  mutate(Maerz=as.integer(df_lm_train_WG3$Monat_c=="März")) %>%
  mutate(April=as.integer(df_lm_train_WG3$Monat_c=="April")) %>%
  mutate(Mai=as.integer(df_lm_train_WG3$Monat_c=="Mai")) %>%
  mutate(Juni=as.integer(df_lm_train_WG3$Monat_c=="Juni")) %>%
  mutate(Juli=as.integer(df_lm_train_WG3$Monat_c=="Juli")) %>%
  mutate(August=as.integer(df_lm_train_WG3$Monat_c=="August")) %>%
  mutate(September=as.integer(df_lm_train_WG3$Monat_c=="September")) %>%
  mutate(Oktober=as.integer(df_lm_train_WG3$Monat_c=="Oktober")) %>%
  mutate(November=as.integer(df_lm_train_WG3$Monat_c=="November")) %>%
  mutate(Dezember=as.integer(df_lm_train_WG3$Monat_c=="Dezember")) %>%
  mutate(Fruehling=as.integer(df_lm_train_WG3$Jahreszeit=="Fruehling")) %>%
  mutate(Sommer=as.integer(df_lm_train_WG3$Jahreszeit=="Sommer")) %>%
  mutate(Herbst=as.integer(df_lm_train_WG3$Jahreszeit=="Herbst")) %>%
  mutate(Winter=as.integer(df_lm_train_WG3$Jahreszeit=="Winter")) %>%
  dplyr::select(-Wochentag_c, -Monat_c, -Jahreszeit)

df_lm_test_WG3_30 <- df_lm_test_WG3 %>%
  mutate(Montag=as.integer(df_lm_test_WG3$Wochentag_c=="Montag")) %>%
  mutate(Dienstag=as.integer(df_lm_test_WG3$Wochentag_c=="Dienstag")) %>%
  mutate(Mittwoch=as.integer(df_lm_test_WG3$Wochentag_c=="Mittwoch")) %>%
  mutate(Donnerstag=as.integer(df_lm_test_WG3$Wochentag_c=="Donnerstag")) %>%
  mutate(Freitag=as.integer(df_lm_test_WG3$Wochentag_c=="Freitag")) %>%
  mutate(Samstag=as.integer(df_lm_test_WG3$Wochentag_c=="Samstag")) %>%
  mutate(Sonntag=as.integer(df_lm_test_WG3$Wochentag_c=="Sonntag")) %>%
  mutate(Januar=as.integer(df_lm_test_WG3$Monat_c=="Januar")) %>%
  mutate(Februar=as.integer(df_lm_test_WG3$Monat_c=="Februar")) %>%
  mutate(Maerz=as.integer(df_lm_test_WG3$Monat_c=="März")) %>%
  mutate(April=as.integer(df_lm_test_WG3$Monat_c=="April")) %>%
  mutate(Mai=as.integer(df_lm_test_WG3$Monat_c=="Mai")) %>%
  mutate(Juni=as.integer(df_lm_test_WG3$Monat_c=="Juni")) %>%
  mutate(Juli=as.integer(df_lm_test_WG3$Monat_c=="Juli")) %>%
  mutate(August=as.integer(df_lm_test_WG3$Monat_c=="August")) %>%
  mutate(September=as.integer(df_lm_test_WG3$Monat_c=="September")) %>%
  mutate(Oktober=as.integer(df_lm_test_WG3$Monat_c=="Oktober")) %>%
  mutate(November=as.integer(df_lm_test_WG3$Monat_c=="November")) %>%
  mutate(Dezember=as.integer(df_lm_test_WG3$Monat_c=="Dezember")) %>%
  mutate(Fruehling=as.integer(df_lm_test_WG2$Jahreszeit=="Fruehling")) %>%
  mutate(Sommer=as.integer(df_lm_test_WG3$Jahreszeit=="Sommer")) %>%
  mutate(Herbst=as.integer(df_lm_test_WG3$Jahreszeit=="Herbst")) %>%
  mutate(Winter=as.integer(df_lm_test_WG3$Jahreszeit=="Winter")) %>%
  dplyr::select(-Wochentag_c, -Monat_c, -Jahreszeit)

Für das 30-Variablenmodell wird nun ein Regressionsmodell erstellt:

## # A tibble: 1 x 11
##   r.squared adj.r.squared sigma statistic p.value    df logLik    AIC
##       <dbl>         <dbl> <dbl>     <dbl>   <dbl> <int>  <dbl>  <dbl>
## 1     0.832         0.827  27.6      170.       0    31 -5011. 10087.
## # ... with 3 more variables: BIC <dbl>, deviance <dbl>, df.residual <int>

Dann wird (die Modellgüte) anhand der Test-Stichprobe getestet:

Als Ergebnis wird ein Vektor erzeugt, der für jede Beobachtung des Test-Samples den geschätzten (vorhergesagten) Umsatzwert speichert. Die Gütewerte lassen sich mit caret::postResample ausgeben:

##       RMSE   Rsquared        MAE 
## 41.5002364  0.8412858 30.9411360

Diese Vorhersage-Ergebnisse werden den Test-Daten hinzugefügt, sodann die Gütekennzahlen berechnet, die wiederum der gemeinsamen Übersichtstabelle für die Gütekennzahlen lm_vgl_kennz hinzugefügt werden:

# Hinzufügen der Ergebnisse
df_lm_test_WG3_30 <- df_lm_test_WG3_30 %>%
  mutate(predicted = lm_WG3_30_predict)

# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
df_lm_test_WG3_30 <- df_lm_test_WG3_30 %>%
  mutate(Prognose_zuhoch = (predicted >= Umsatz)) %>%
  mutate(Abweichung = predicted - Umsatz) %>%
  mutate(Abweichung_abs = abs(predicted - Umsatz)) %>%
  mutate(Abweichung_rel = (predicted - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Ergänze die benötigten Hilfsgrößen
df_lm_test_WG3_30 <-df_lm_test_WG3_30 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- df_lm_test_WG3_30 %>%
  group_by() %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz), 2), Umsatz_mittel = round(sum(Umsatz)/n(), 2), MAE = round(mean(Abweichung_abs), 2), MPE = round(mean(Abweichung_rel)*100, 2), MAPE = round(mean(Abweichung_rel_abs)*100, 2), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100, 2), MSE = round(mean(Abweichung_quad), 2), RMSE = round(sqrt(mean(Abweichung_quad)), 2), rRMSE = round(RMSE/Umsatz_mittel*100, 2))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "best30_WG3")

# füge die Kennzahlen nun an die Vergleichstabelle
lm_vgl_kennz <- rbind(lm_vgl_kennz, temp)
lm_vgl_kennz
## # A tibble: 10 x 11
##    Anzahl Umsatz_ges Umsatz_mittel   MAE   MPE  MAPE  WAPE   MSE  RMSE
##     <int>      <dbl>         <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
##  1    346     45738.          132.  24.8 -7.84  18.7  18.8 1067.  32.7
##  2    346     45738.          132.  24.8 -7.65  18.8  18.8 1064.  32.6
##  3    346     45738.          132.  24.7 -7.93  18.5  18.7 1050.  32.4
##  4    346     45738.          132.  24.7 -7.91  18.6  18.7 1050.  32.4
##  5    346    130413.          377.  39.8  3.37  11.4  10.6 2708.  52.0
##  6    346    130413.          377.  39.8  3.45  11.4  10.6 2722.  52.2
##  7    346    130413.          377.  40.3  3.48  11.6  10.7 2768.  52.6
##  8    346    130413.          377.  39.9  3.52  11.5  10.6 2720.  52.2
##  9    346     59316.          171.  31.2 -8.4   17.3  18.2 1751.  41.8
## 10    346     59316.          171.  30.9 -8.38  17.4  18.0 1722.  41.5
## # ... with 2 more variables: rRMSE <dbl>, Modell <chr>

Auch bei der Warengruppe 3 gibt es hnur marginale Unterschiede zwischen dem 20- und dem 30-Variablen-Modell. Letzteres performt ein wenig besser, aht aber den Nachteil, dass es 50% mehr Prädikatoren enthält. Es ist die Frage, ob sich das Aufblähen des Modells für eine solch marginale Verbesserung lohnt. An dieser Stelle wird das bisherige Vorgehen weiterverfolgt und gemessen an den Gütekriterien das 30-Variablen-Modell ausgewählt.

Die 30 Variablen, die am besten geeignet sind um Prognosen für die Umsätze der Warengruppe 3 vorzunehmen sind:

  • KielerWoche
  • Temperatur
  • Bewoelkung
  • Wochentage:
    • Freitag
    • Montag
    • Samstag
    • Sonntag
  • Monate:
    • August
    • Februar
    • Januar
    • Juli
    • Juni
    • Mai
    • März
    • Oktober
    • September
  • Sommerferien
    • SH
    • NRW
    • NDS
    • HE
  • Ostern
  • Pfingsten
  • TDE
  • Ostern_ext
  • ChristiHimmelfahrt_ext
  • Pfingsten_ext
  • Silvester_ext
  • Jahreszeiten:
    • Herbst
    • Sommer
    • Winter

6.3.4 Warengruppe 4

Erstellung von Trainings- und Testdatensätzen für Warengruppe 5

Auswahl der am besten geeigneten Variablen Was die Vorgehensweise und die enstsprechenden Erläuterungen anbelangt, siehe 6.3.1.

Beste Teilmengenauswahl (“Best subset selection”)

Die regsubsets-Funktion gibt ein Listenobjekt mit vielen Informationen zurück. Zunächst kann der Befehl summary verwendet, um den besten Satz von Variablen für jede Modellgröße zu ermitteln.

## Subset selection object
## Call: regsubsets.formula(Umsatz ~ ., df_lm_train_WG4, nvmax = 37)
## 37 Variables  (and intercept)
##                        Forced in Forced out
## KielerWoche                FALSE      FALSE
## Bewoelkung                 FALSE      FALSE
## Temperatur                 FALSE      FALSE
## Windgeschwindigkeit        FALSE      FALSE
## Wochentag_cDonnerstag      FALSE      FALSE
## Wochentag_cFreitag         FALSE      FALSE
## Wochentag_cMittwoch        FALSE      FALSE
## Wochentag_cMontag          FALSE      FALSE
## Wochentag_cSamstag         FALSE      FALSE
## Wochentag_cSonntag         FALSE      FALSE
## Monat_cAugust              FALSE      FALSE
## Monat_cDezember            FALSE      FALSE
## Monat_cFebruar             FALSE      FALSE
## Monat_cJanuar              FALSE      FALSE
## Monat_cJuli                FALSE      FALSE
## Monat_cJuni                FALSE      FALSE
## Monat_cMai                 FALSE      FALSE
## Monat_cMärz                FALSE      FALSE
## Monat_cNovember            FALSE      FALSE
## Monat_cOktober             FALSE      FALSE
## Monat_cSeptember           FALSE      FALSE
## SommerferienSH             FALSE      FALSE
## SommerferienNRW            FALSE      FALSE
## SommerferienNDS            FALSE      FALSE
## SommerferienHE             FALSE      FALSE
## Feiertag                   FALSE      FALSE
## Ostern                     FALSE      FALSE
## ChristiHimmelfahrt         FALSE      FALSE
## Pfingsten                  FALSE      FALSE
## TDE                        FALSE      FALSE
## Ostern_ext                 FALSE      FALSE
## ChristiHimmelfahrt_ext     FALSE      FALSE
## Pfingsten_ext              FALSE      FALSE
## Silvester_ext              FALSE      FALSE
## JahreszeitHerbst           FALSE      FALSE
## JahreszeitSommer           FALSE      FALSE
## JahreszeitWinter           FALSE      FALSE
## 1 subsets of each size up to 37
## Selection Algorithm: exhaustive
##           KielerWoche Bewoelkung Temperatur Windgeschwindigkeit
## 1  ( 1 )  " "         " "        " "        " "                
## 2  ( 1 )  " "         " "        " "        " "                
## 3  ( 1 )  " "         " "        " "        " "                
## 4  ( 1 )  " "         " "        " "        " "                
## 5  ( 1 )  " "         " "        " "        " "                
## 6  ( 1 )  " "         " "        " "        " "                
## 7  ( 1 )  " "         " "        " "        " "                
## 8  ( 1 )  " "         " "        " "        " "                
## 9  ( 1 )  " "         " "        " "        " "                
## 10  ( 1 ) " "         " "        " "        " "                
## 11  ( 1 ) " "         " "        " "        " "                
## 12  ( 1 ) " "         " "        " "        " "                
## 13  ( 1 ) " "         " "        " "        " "                
## 14  ( 1 ) " "         " "        " "        " "                
## 15  ( 1 ) " "         " "        " "        " "                
## 16  ( 1 ) " "         " "        " "        " "                
## 17  ( 1 ) " "         " "        " "        " "                
## 18  ( 1 ) " "         " "        " "        " "                
## 19  ( 1 ) " "         " "        "*"        " "                
## 20  ( 1 ) " "         " "        "*"        " "                
## 21  ( 1 ) " "         " "        "*"        " "                
## 22  ( 1 ) " "         " "        "*"        " "                
## 23  ( 1 ) " "         " "        "*"        " "                
## 24  ( 1 ) " "         " "        "*"        " "                
## 25  ( 1 ) " "         " "        "*"        " "                
## 26  ( 1 ) " "         "*"        "*"        " "                
## 27  ( 1 ) " "         "*"        "*"        "*"                
## 28  ( 1 ) " "         "*"        "*"        "*"                
## 29  ( 1 ) " "         "*"        "*"        "*"                
## 30  ( 1 ) " "         "*"        "*"        "*"                
## 31  ( 1 ) " "         "*"        "*"        "*"                
## 32  ( 1 ) " "         "*"        "*"        "*"                
## 33  ( 1 ) " "         "*"        "*"        "*"                
## 34  ( 1 ) "*"         "*"        "*"        "*"                
## 35  ( 1 ) "*"         "*"        "*"        "*"                
## 36  ( 1 ) "*"         "*"        "*"        "*"                
## 37  ( 1 ) "*"         "*"        "*"        "*"                
##           Wochentag_cDonnerstag Wochentag_cFreitag Wochentag_cMittwoch
## 1  ( 1 )  " "                   " "                " "                
## 2  ( 1 )  " "                   " "                " "                
## 3  ( 1 )  " "                   " "                " "                
## 4  ( 1 )  " "                   " "                " "                
## 5  ( 1 )  " "                   " "                " "                
## 6  ( 1 )  " "                   " "                " "                
## 7  ( 1 )  " "                   " "                " "                
## 8  ( 1 )  " "                   " "                " "                
## 9  ( 1 )  " "                   " "                " "                
## 10  ( 1 ) " "                   " "                " "                
## 11  ( 1 ) " "                   " "                " "                
## 12  ( 1 ) " "                   " "                " "                
## 13  ( 1 ) "*"                   " "                " "                
## 14  ( 1 ) "*"                   " "                " "                
## 15  ( 1 ) " "                   "*"                " "                
## 16  ( 1 ) "*"                   " "                "*"                
## 17  ( 1 ) " "                   "*"                " "                
## 18  ( 1 ) "*"                   " "                "*"                
## 19  ( 1 ) "*"                   " "                "*"                
## 20  ( 1 ) " "                   "*"                " "                
## 21  ( 1 ) "*"                   "*"                " "                
## 22  ( 1 ) " "                   "*"                " "                
## 23  ( 1 ) "*"                   "*"                " "                
## 24  ( 1 ) "*"                   "*"                " "                
## 25  ( 1 ) "*"                   "*"                " "                
## 26  ( 1 ) "*"                   "*"                " "                
## 27  ( 1 ) "*"                   "*"                " "                
## 28  ( 1 ) "*"                   "*"                "*"                
## 29  ( 1 ) "*"                   "*"                "*"                
## 30  ( 1 ) "*"                   "*"                "*"                
## 31  ( 1 ) "*"                   "*"                "*"                
## 32  ( 1 ) "*"                   "*"                "*"                
## 33  ( 1 ) "*"                   "*"                "*"                
## 34  ( 1 ) "*"                   "*"                "*"                
## 35  ( 1 ) "*"                   "*"                "*"                
## 36  ( 1 ) "*"                   "*"                "*"                
## 37  ( 1 ) "*"                   "*"                "*"                
##           Wochentag_cMontag Wochentag_cSamstag Wochentag_cSonntag
## 1  ( 1 )  " "               " "                "*"               
## 2  ( 1 )  " "               " "                "*"               
## 3  ( 1 )  " "               " "                "*"               
## 4  ( 1 )  " "               " "                "*"               
## 5  ( 1 )  " "               "*"                "*"               
## 6  ( 1 )  " "               "*"                "*"               
## 7  ( 1 )  " "               "*"                "*"               
## 8  ( 1 )  " "               "*"                "*"               
## 9  ( 1 )  " "               "*"                "*"               
## 10  ( 1 ) " "               "*"                "*"               
## 11  ( 1 ) " "               "*"                "*"               
## 12  ( 1 ) " "               "*"                "*"               
## 13  ( 1 ) " "               "*"                "*"               
## 14  ( 1 ) " "               "*"                "*"               
## 15  ( 1 ) "*"               "*"                "*"               
## 16  ( 1 ) " "               "*"                "*"               
## 17  ( 1 ) "*"               "*"                "*"               
## 18  ( 1 ) " "               "*"                "*"               
## 19  ( 1 ) " "               "*"                "*"               
## 20  ( 1 ) "*"               "*"                "*"               
## 21  ( 1 ) "*"               "*"                "*"               
## 22  ( 1 ) "*"               "*"                "*"               
## 23  ( 1 ) "*"               "*"                "*"               
## 24  ( 1 ) "*"               "*"                "*"               
## 25  ( 1 ) "*"               "*"                "*"               
## 26  ( 1 ) "*"               "*"                "*"               
## 27  ( 1 ) "*"               "*"                "*"               
## 28  ( 1 ) "*"               "*"                "*"               
## 29  ( 1 ) "*"               "*"                "*"               
## 30  ( 1 ) "*"               "*"                "*"               
## 31  ( 1 ) "*"               "*"                "*"               
## 32  ( 1 ) "*"               "*"                "*"               
## 33  ( 1 ) "*"               "*"                "*"               
## 34  ( 1 ) "*"               "*"                "*"               
## 35  ( 1 ) "*"               "*"                "*"               
## 36  ( 1 ) "*"               "*"                "*"               
## 37  ( 1 ) "*"               "*"                "*"               
##           Monat_cAugust Monat_cDezember Monat_cFebruar Monat_cJanuar
## 1  ( 1 )  " "           " "             " "            " "          
## 2  ( 1 )  " "           " "             "*"            " "          
## 3  ( 1 )  " "           " "             "*"            " "          
## 4  ( 1 )  "*"           " "             "*"            " "          
## 5  ( 1 )  "*"           " "             "*"            " "          
## 6  ( 1 )  "*"           " "             "*"            " "          
## 7  ( 1 )  "*"           " "             "*"            " "          
## 8  ( 1 )  " "           " "             "*"            " "          
## 9  ( 1 )  " "           " "             "*"            " "          
## 10  ( 1 ) "*"           " "             "*"            " "          
## 11  ( 1 ) " "           " "             "*"            " "          
## 12  ( 1 ) " "           " "             "*"            " "          
## 13  ( 1 ) " "           " "             "*"            " "          
## 14  ( 1 ) " "           " "             "*"            " "          
## 15  ( 1 ) " "           " "             "*"            " "          
## 16  ( 1 ) " "           " "             "*"            " "          
## 17  ( 1 ) " "           " "             "*"            " "          
## 18  ( 1 ) " "           "*"             "*"            " "          
## 19  ( 1 ) " "           "*"             "*"            " "          
## 20  ( 1 ) " "           "*"             "*"            " "          
## 21  ( 1 ) " "           "*"             "*"            " "          
## 22  ( 1 ) " "           "*"             "*"            "*"          
## 23  ( 1 ) " "           "*"             "*"            "*"          
## 24  ( 1 ) " "           "*"             "*"            "*"          
## 25  ( 1 ) " "           "*"             "*"            "*"          
## 26  ( 1 ) " "           "*"             "*"            "*"          
## 27  ( 1 ) " "           "*"             "*"            "*"          
## 28  ( 1 ) " "           "*"             "*"            "*"          
## 29  ( 1 ) " "           "*"             "*"            "*"          
## 30  ( 1 ) " "           "*"             "*"            "*"          
## 31  ( 1 ) " "           "*"             "*"            "*"          
## 32  ( 1 ) " "           "*"             "*"            "*"          
## 33  ( 1 ) " "           "*"             "*"            "*"          
## 34  ( 1 ) " "           "*"             "*"            "*"          
## 35  ( 1 ) " "           "*"             "*"            "*"          
## 36  ( 1 ) " "           "*"             "*"            "*"          
## 37  ( 1 ) "*"           "*"             "*"            "*"          
##           Monat_cJuli Monat_cJuni Monat_cMai Monat_cMärz Monat_cNovember
## 1  ( 1 )  " "         " "         " "        " "         " "            
## 2  ( 1 )  " "         " "         " "        " "         " "            
## 3  ( 1 )  " "         " "         " "        " "         " "            
## 4  ( 1 )  " "         " "         " "        " "         " "            
## 5  ( 1 )  " "         " "         " "        " "         " "            
## 6  ( 1 )  " "         " "         " "        " "         " "            
## 7  ( 1 )  " "         " "         " "        " "         " "            
## 8  ( 1 )  "*"         "*"         " "        " "         " "            
## 9  ( 1 )  "*"         "*"         " "        " "         " "            
## 10  ( 1 ) " "         " "         " "        " "         " "            
## 11  ( 1 ) "*"         "*"         " "        " "         " "            
## 12  ( 1 ) "*"         "*"         " "        " "         " "            
## 13  ( 1 ) "*"         "*"         " "        " "         " "            
## 14  ( 1 ) "*"         "*"         " "        " "         " "            
## 15  ( 1 ) "*"         "*"         " "        " "         " "            
## 16  ( 1 ) "*"         "*"         " "        " "         " "            
## 17  ( 1 ) "*"         "*"         " "        " "         " "            
## 18  ( 1 ) "*"         "*"         " "        " "         "*"            
## 19  ( 1 ) "*"         "*"         " "        " "         "*"            
## 20  ( 1 ) "*"         "*"         " "        " "         "*"            
## 21  ( 1 ) "*"         "*"         " "        " "         "*"            
## 22  ( 1 ) "*"         "*"         " "        " "         "*"            
## 23  ( 1 ) "*"         "*"         " "        " "         "*"            
## 24  ( 1 ) "*"         "*"         " "        " "         "*"            
## 25  ( 1 ) "*"         "*"         " "        " "         "*"            
## 26  ( 1 ) "*"         "*"         " "        " "         "*"            
## 27  ( 1 ) "*"         "*"         " "        " "         "*"            
## 28  ( 1 ) "*"         "*"         " "        " "         "*"            
## 29  ( 1 ) "*"         "*"         "*"        " "         "*"            
## 30  ( 1 ) "*"         "*"         "*"        "*"         "*"            
## 31  ( 1 ) "*"         "*"         "*"        "*"         "*"            
## 32  ( 1 ) "*"         "*"         "*"        "*"         "*"            
## 33  ( 1 ) "*"         "*"         "*"        "*"         "*"            
## 34  ( 1 ) "*"         "*"         "*"        "*"         "*"            
## 35  ( 1 ) "*"         "*"         "*"        "*"         "*"            
## 36  ( 1 ) "*"         "*"         "*"        "*"         "*"            
## 37  ( 1 ) "*"         "*"         "*"        "*"         "*"            
##           Monat_cOktober Monat_cSeptember SommerferienSH SommerferienNRW
## 1  ( 1 )  " "            " "              " "            " "            
## 2  ( 1 )  " "            " "              " "            " "            
## 3  ( 1 )  " "            " "              " "            " "            
## 4  ( 1 )  " "            " "              " "            " "            
## 5  ( 1 )  " "            " "              " "            " "            
## 6  ( 1 )  " "            "*"              " "            " "            
## 7  ( 1 )  " "            "*"              " "            " "            
## 8  ( 1 )  " "            " "              " "            " "            
## 9  ( 1 )  " "            " "              " "            " "            
## 10  ( 1 ) " "            "*"              " "            " "            
## 11  ( 1 ) " "            " "              " "            " "            
## 12  ( 1 ) " "            " "              "*"            " "            
## 13  ( 1 ) " "            " "              "*"            " "            
## 14  ( 1 ) " "            " "              "*"            " "            
## 15  ( 1 ) " "            " "              "*"            " "            
## 16  ( 1 ) " "            " "              "*"            " "            
## 17  ( 1 ) " "            " "              "*"            " "            
## 18  ( 1 ) " "            " "              "*"            " "            
## 19  ( 1 ) " "            " "              "*"            " "            
## 20  ( 1 ) " "            " "              "*"            " "            
## 21  ( 1 ) " "            " "              "*"            " "            
## 22  ( 1 ) " "            " "              "*"            " "            
## 23  ( 1 ) " "            " "              "*"            " "            
## 24  ( 1 ) "*"            " "              "*"            " "            
## 25  ( 1 ) "*"            " "              "*"            " "            
## 26  ( 1 ) "*"            " "              "*"            " "            
## 27  ( 1 ) "*"            " "              "*"            " "            
## 28  ( 1 ) "*"            " "              "*"            " "            
## 29  ( 1 ) "*"            " "              "*"            " "            
## 30  ( 1 ) "*"            " "              "*"            " "            
## 31  ( 1 ) "*"            " "              "*"            " "            
## 32  ( 1 ) "*"            " "              "*"            "*"            
## 33  ( 1 ) "*"            "*"              "*"            "*"            
## 34  ( 1 ) "*"            "*"              "*"            "*"            
## 35  ( 1 ) "*"            "*"              "*"            "*"            
## 36  ( 1 ) "*"            "*"              "*"            "*"            
## 37  ( 1 ) "*"            "*"              "*"            "*"            
##           SommerferienNDS SommerferienHE Feiertag Ostern
## 1  ( 1 )  " "             " "            " "      " "   
## 2  ( 1 )  " "             " "            " "      " "   
## 3  ( 1 )  " "             " "            "*"      " "   
## 4  ( 1 )  " "             " "            "*"      " "   
## 5  ( 1 )  " "             " "            "*"      " "   
## 6  ( 1 )  " "             " "            "*"      " "   
## 7  ( 1 )  " "             " "            "*"      " "   
## 8  ( 1 )  " "             " "            "*"      " "   
## 9  ( 1 )  " "             " "            " "      " "   
## 10  ( 1 ) " "             " "            "*"      "*"   
## 11  ( 1 ) " "             " "            "*"      "*"   
## 12  ( 1 ) " "             " "            "*"      "*"   
## 13  ( 1 ) " "             " "            "*"      "*"   
## 14  ( 1 ) " "             " "            "*"      "*"   
## 15  ( 1 ) " "             " "            "*"      "*"   
## 16  ( 1 ) " "             " "            "*"      "*"   
## 17  ( 1 ) " "             " "            "*"      "*"   
## 18  ( 1 ) " "             " "            "*"      "*"   
## 19  ( 1 ) " "             " "            "*"      "*"   
## 20  ( 1 ) " "             " "            "*"      "*"   
## 21  ( 1 ) " "             " "            "*"      "*"   
## 22  ( 1 ) " "             " "            "*"      "*"   
## 23  ( 1 ) " "             " "            "*"      "*"   
## 24  ( 1 ) " "             " "            "*"      "*"   
## 25  ( 1 ) " "             " "            "*"      "*"   
## 26  ( 1 ) " "             " "            "*"      "*"   
## 27  ( 1 ) " "             " "            "*"      "*"   
## 28  ( 1 ) " "             " "            "*"      "*"   
## 29  ( 1 ) " "             " "            "*"      "*"   
## 30  ( 1 ) " "             " "            "*"      "*"   
## 31  ( 1 ) " "             "*"            "*"      "*"   
## 32  ( 1 ) " "             "*"            "*"      "*"   
## 33  ( 1 ) " "             "*"            "*"      "*"   
## 34  ( 1 ) " "             "*"            "*"      "*"   
## 35  ( 1 ) "*"             "*"            "*"      "*"   
## 36  ( 1 ) "*"             "*"            "*"      "*"   
## 37  ( 1 ) "*"             "*"            "*"      "*"   
##           ChristiHimmelfahrt Pfingsten TDE Ostern_ext
## 1  ( 1 )  " "                " "       " " " "       
## 2  ( 1 )  " "                " "       " " " "       
## 3  ( 1 )  " "                " "       " " " "       
## 4  ( 1 )  " "                " "       " " " "       
## 5  ( 1 )  " "                " "       " " " "       
## 6  ( 1 )  " "                " "       " " " "       
## 7  ( 1 )  " "                " "       " " " "       
## 8  ( 1 )  " "                " "       " " " "       
## 9  ( 1 )  "*"                "*"       "*" " "       
## 10  ( 1 ) "*"                "*"       "*" " "       
## 11  ( 1 ) "*"                "*"       "*" " "       
## 12  ( 1 ) "*"                "*"       "*" " "       
## 13  ( 1 ) "*"                "*"       "*" " "       
## 14  ( 1 ) "*"                "*"       "*" " "       
## 15  ( 1 ) "*"                "*"       "*" " "       
## 16  ( 1 ) "*"                "*"       "*" " "       
## 17  ( 1 ) "*"                "*"       "*" " "       
## 18  ( 1 ) "*"                "*"       "*" " "       
## 19  ( 1 ) "*"                "*"       "*" " "       
## 20  ( 1 ) "*"                "*"       "*" " "       
## 21  ( 1 ) "*"                "*"       "*" " "       
## 22  ( 1 ) "*"                "*"       "*" " "       
## 23  ( 1 ) "*"                "*"       "*" " "       
## 24  ( 1 ) "*"                "*"       "*" " "       
## 25  ( 1 ) "*"                "*"       "*" "*"       
## 26  ( 1 ) "*"                "*"       "*" "*"       
## 27  ( 1 ) "*"                "*"       "*" "*"       
## 28  ( 1 ) "*"                "*"       "*" "*"       
## 29  ( 1 ) "*"                "*"       "*" "*"       
## 30  ( 1 ) "*"                "*"       "*" "*"       
## 31  ( 1 ) "*"                "*"       "*" "*"       
## 32  ( 1 ) "*"                "*"       "*" "*"       
## 33  ( 1 ) "*"                "*"       "*" "*"       
## 34  ( 1 ) "*"                "*"       "*" "*"       
## 35  ( 1 ) "*"                "*"       "*" "*"       
## 36  ( 1 ) "*"                "*"       "*" "*"       
## 37  ( 1 ) "*"                "*"       "*" "*"       
##           ChristiHimmelfahrt_ext Pfingsten_ext Silvester_ext
## 1  ( 1 )  " "                    " "           " "          
## 2  ( 1 )  " "                    " "           " "          
## 3  ( 1 )  " "                    " "           " "          
## 4  ( 1 )  " "                    " "           " "          
## 5  ( 1 )  " "                    " "           " "          
## 6  ( 1 )  " "                    " "           " "          
## 7  ( 1 )  " "                    " "           "*"          
## 8  ( 1 )  " "                    " "           "*"          
## 9  ( 1 )  " "                    " "           " "          
## 10  ( 1 ) " "                    " "           " "          
## 11  ( 1 ) " "                    " "           " "          
## 12  ( 1 ) " "                    " "           " "          
## 13  ( 1 ) " "                    " "           " "          
## 14  ( 1 ) " "                    " "           " "          
## 15  ( 1 ) " "                    " "           " "          
## 16  ( 1 ) "*"                    " "           " "          
## 17  ( 1 ) "*"                    "*"           " "          
## 18  ( 1 ) "*"                    " "           " "          
## 19  ( 1 ) "*"                    " "           " "          
## 20  ( 1 ) "*"                    "*"           " "          
## 21  ( 1 ) "*"                    "*"           " "          
## 22  ( 1 ) "*"                    "*"           " "          
## 23  ( 1 ) "*"                    "*"           " "          
## 24  ( 1 ) "*"                    "*"           " "          
## 25  ( 1 ) "*"                    "*"           " "          
## 26  ( 1 ) "*"                    "*"           " "          
## 27  ( 1 ) "*"                    "*"           " "          
## 28  ( 1 ) "*"                    "*"           " "          
## 29  ( 1 ) "*"                    "*"           " "          
## 30  ( 1 ) "*"                    "*"           " "          
## 31  ( 1 ) "*"                    "*"           " "          
## 32  ( 1 ) "*"                    "*"           " "          
## 33  ( 1 ) "*"                    "*"           " "          
## 34  ( 1 ) "*"                    "*"           " "          
## 35  ( 1 ) "*"                    "*"           " "          
## 36  ( 1 ) "*"                    "*"           "*"          
## 37  ( 1 ) "*"                    "*"           "*"          
##           JahreszeitHerbst JahreszeitSommer JahreszeitWinter
## 1  ( 1 )  " "              " "              " "             
## 2  ( 1 )  " "              " "              " "             
## 3  ( 1 )  " "              " "              " "             
## 4  ( 1 )  " "              " "              " "             
## 5  ( 1 )  " "              " "              " "             
## 6  ( 1 )  " "              " "              " "             
## 7  ( 1 )  " "              " "              " "             
## 8  ( 1 )  " "              "*"              " "             
## 9  ( 1 )  " "              "*"              " "             
## 10  ( 1 ) " "              " "              " "             
## 11  ( 1 ) " "              "*"              " "             
## 12  ( 1 ) " "              "*"              " "             
## 13  ( 1 ) " "              "*"              " "             
## 14  ( 1 ) "*"              "*"              " "             
## 15  ( 1 ) "*"              "*"              " "             
## 16  ( 1 ) "*"              "*"              " "             
## 17  ( 1 ) "*"              "*"              " "             
## 18  ( 1 ) "*"              "*"              " "             
## 19  ( 1 ) "*"              "*"              " "             
## 20  ( 1 ) "*"              "*"              " "             
## 21  ( 1 ) "*"              "*"              " "             
## 22  ( 1 ) "*"              "*"              "*"             
## 23  ( 1 ) "*"              "*"              "*"             
## 24  ( 1 ) "*"              "*"              "*"             
## 25  ( 1 ) "*"              "*"              "*"             
## 26  ( 1 ) "*"              "*"              "*"             
## 27  ( 1 ) "*"              "*"              "*"             
## 28  ( 1 ) "*"              "*"              "*"             
## 29  ( 1 ) "*"              "*"              "*"             
## 30  ( 1 ) "*"              "*"              "*"             
## 31  ( 1 ) "*"              "*"              "*"             
## 32  ( 1 ) "*"              "*"              "*"             
## 33  ( 1 ) "*"              "*"              "*"             
## 34  ( 1 ) "*"              "*"              "*"             
## 35  ( 1 ) "*"              "*"              "*"             
## 36  ( 1 ) "*"              "*"              "*"             
## 37  ( 1 ) "*"              "*"              "*"

Für ein Modell mit einer Variablen kann beobachtet werden, dass die Variable Wochentag_cSonntag ein Sternchen hat, was signalisiert, dass ein Regressionsmodell mit Umsatz ~ Wochentag_cSonntag das beste Einzelvariablenmodell ist. Das beste 2-Variablen-Modell ist Umsatz ~ Wochentag_cSonntag + Monat_cFebruar. Das beste 3-Variablen-Modell ist Umsatz ~ Wochentag_cSonntag + Monat_cFebruar + Feiertag. Und so weiter.

Schrittweise Auswahl (“Stepwise selection”)

Schrittweise vorwärts (Forward stepwise)

Die schrittweise Vorwärtsauswahl kann mit regsubsets durchgeführt werden, indem die method = "forward" gesetzt wird:

Schrittweise rückwärts (Backward stepwise)

Die schrittweise Vorwärtsauswahl kann mit regsubsets durchgeführt werden, indem die method = "backward" gesetzt wird:

Modellauswahl

Indirekte Schätzung des Testfehlers mit \(C_{p}\), \(AIC\), \(BIC\) und adjustiertem \(R^2\)

## [1] 20
## [1] 11
## [1] 14

Es ist erkennbar, dass die Ergebnisse leicht unterschiedliche Modelle identifizieren, die als die besten angesehen werden. Die ajustierte \(R^2\)-Statistik legt nahe, dass ein 20-Variablen-Modell bevorzugt wird, die \(BIC\)-Statistik schlägt ein 11-Variablenmodell vor und der \(C_{p}\) ein 14-Variablen-Modell vor.

Das Ergebnis wird verglichen mit der Auswahl nach forward und backward selection:

## [1] 18
## [1] 15

Wenn man das optimale \(C_{p}\) für vorwärts und rückwärts schrittweise bewertet, ist erkennbar, dass gemäß der Vorwärts-Methode ein 18-Variablen-Modell die \(C_{p}\)-Statistik minimiert. Die Rückwärtsmethode schlägt ein 15-Variablen-Modell vor.

Wenn wir diese Modelle bewerten, ergibt sich bzgl. der Zusammensetzung der Prädikatoren folgendes Bild:.

##        (Intercept) Wochentag_cSamstag Wochentag_cSonntag 
##           74.74631           10.82251           53.05171 
##     Monat_cFebruar        Monat_cJuli        Monat_cJuni 
##           42.54486          -16.78346          -13.94296 
##           Feiertag             Ostern ChristiHimmelfahrt 
##          -59.20842           85.71959          118.97211 
##          Pfingsten                TDE   JahreszeitSommer 
##          117.38558          101.92794           11.79000
##           (Intercept) Wochentag_cDonnerstag    Wochentag_cSamstag 
##             74.203835             -4.515529              9.918655 
##    Wochentag_cSonntag        Monat_cFebruar           Monat_cJuli 
##             52.287664             43.960289            -14.855994 
##           Monat_cJuni        SommerferienSH              Feiertag 
##            -11.663708              6.951056            -57.831994 
##                Ostern    ChristiHimmelfahrt             Pfingsten 
##             85.267661            122.653688            116.173897 
##                   TDE      JahreszeitHerbst      JahreszeitSommer 
##             98.098575              3.296699              9.311380
##            (Intercept)             Temperatur     Wochentag_cFreitag 
##             73.6246055             -0.2397414              5.1100427 
##      Wochentag_cMontag     Wochentag_cSamstag     Wochentag_cSonntag 
##              3.7589249             12.2146160             54.8519519 
##        Monat_cDezember         Monat_cFebruar            Monat_cJuli 
##             -5.3086879             42.8280457            -14.6256190 
##            Monat_cJuni        Monat_cNovember         SommerferienSH 
##            -10.3440932             -6.5248038              7.4226525 
##               Feiertag                 Ostern     ChristiHimmelfahrt 
##            -52.8038954             79.6430427            105.6638117 
##              Pfingsten                    TDE ChristiHimmelfahrt_ext 
##             96.8512966             91.5348039             11.6375819 
##          Pfingsten_ext       JahreszeitHerbst       JahreszeitSommer 
##             14.6446149              6.8375903             11.5166660

Die Auswahl gemäß forward und backward selection ergibt sich wie folgt:

##            (Intercept)             Temperatur  Wochentag_cDonnerstag 
##             77.4830876             -0.2960164             -5.1814174 
##    Wochentag_cMittwoch     Wochentag_cSamstag     Wochentag_cSonntag 
##             -3.5371804              8.6956545             51.2675353 
##          Monat_cAugust         Monat_cFebruar            Monat_cJuni 
##             19.4669849             42.7128158             -5.6629781 
##         Monat_cOktober       Monat_cSeptember               Feiertag 
##              6.3474783             12.6259097            -54.1769228 
##                 Ostern     ChristiHimmelfahrt              Pfingsten 
##             81.2954037            108.1507046            100.7715966 
##                    TDE ChristiHimmelfahrt_ext          Pfingsten_ext 
##             92.7739082             12.6945291             11.1417616 
##          Silvester_ext 
##             -3.8738520
##        (Intercept) Wochentag_cFreitag  Wochentag_cMontag 
##          71.576948           5.216883           3.676093 
## Wochentag_cSamstag Wochentag_cSonntag     Monat_cFebruar 
##          12.587968          54.978079          43.894295 
##        Monat_cJuli        Monat_cJuni     SommerferienSH 
##         -15.119148         -11.754923           6.775400 
##           Feiertag             Ostern ChristiHimmelfahrt 
##         -57.884972          84.764271         120.818023 
##          Pfingsten                TDE   JahreszeitHerbst 
##         115.700912          98.765918           3.194085 
##   JahreszeitSommer 
##           9.451641

Direkte Schätzung des Testfehlers

Nun wird der Fehler der Testdaten für das beste Modell jeder Modellgröße berechnet. Zuerst wird eine Modellmatrix aus den Testdaten erstellt. Die Funktion model.matrix wird in vielen Regressionspaketen zum Erstellen einer X-Matrix aus Daten verwendet.

Jetzt kann jede Modellgröße (d.h. 1 Variable, 2 Variablen,…, 20 Variablen) durchlaufen werden und die Koeffizienten für das beste Modell dieser Größe extrahiert werden. Diese Werte werden sodann in die entsprechenden Spalten der Testmodellmatrix multipliziert, um die Vorhersagen zu bilden. Dann werden die Test-MSE berechnet.

##           [,1]
##  [1,] 525.7183
##  [2,] 599.4985
##  [3,] 610.9880
##  [4,] 620.8920
##  [5,] 616.1449
##  [6,] 610.1408
##  [7,] 603.5582
##  [8,] 580.9132
##  [9,] 602.3907
## [10,] 628.1246
## [11,] 607.1358
## [12,] 603.6362
## [13,] 604.4183
## [14,] 604.7203
## [15,] 604.3582
## [16,] 605.0185
## [17,] 608.0941
## [18,] 597.3093
## [19,] 590.5291
## [20,] 593.1788
## [21,] 593.5012
## [22,] 592.5746
## [23,] 592.8062
## [24,] 591.6309
## [25,] 592.5584
## [26,] 594.3739
## [27,] 594.7218
## [28,] 594.0891
## [29,] 592.2289
## [30,] 594.4524
## [31,] 594.9515
## [32,] 594.5469
## [33,] 594.1381
## [34,] 594.2219
## [35,] 594.2655
## [36,] 594.1626
## [37,] 594.1671

Es ist erkennbar, dass das 1-Variablen-Modell, das durch den besten Teilmengenansatz erzeugt wird, den niedrigsten Test-MSE erzeugt.

Verglichen werden nachfolgend das 1-Variablen-Modell, die 11- und 20-Variablen-Modelle nach best subset selection und die beiden forward und backward-Modelle.

Teilmengenauswahl für das 1-Variablen-Modell

##        (Intercept) Wochentag_cSonntag 
##           81.13245           51.68479

Die Variable ist der Wochentag_cSonntag

Die Variable Wochentag_c muss noch dummyfiziert werden.

# Dummyfizierung der Variablen im Trainigsdatensatz:
df_lm_train_WG4_1 <- df_lm_train_WG4 %>%
  mutate(Montag=as.integer(df_lm_train_WG4$Wochentag_c=="Montag")) %>%
  mutate(Dienstag=as.integer(df_lm_train_WG4$Wochentag_c=="Dienstag")) %>%
  mutate(Mittwoch=as.integer(df_lm_train_WG4$Wochentag_c=="Mittwoch")) %>%
  mutate(Donnerstag=as.integer(df_lm_train_WG4$Wochentag_c=="Donnerstag")) %>%
  mutate(Freitag=as.integer(df_lm_train_WG4$Wochentag_c=="Freitag")) %>%
  mutate(Samstag=as.integer(df_lm_train_WG4$Wochentag_c=="Samstag")) %>%
  mutate(Sonntag=as.integer(df_lm_train_WG4$Wochentag_c=="Sonntag")) %>%
  mutate(Januar=as.integer(df_lm_train_WG4$Monat_c=="Januar")) %>%
  mutate(Februar=as.integer(df_lm_train_WG4$Monat_c=="Februar")) %>%
  mutate(Maerz=as.integer(df_lm_train_WG4$Monat_c=="März")) %>%
  mutate(April=as.integer(df_lm_train_WG4$Monat_c=="April")) %>%
  mutate(Mai=as.integer(df_lm_train_WG4$Monat_c=="Mai")) %>%
  mutate(Juni=as.integer(df_lm_train_WG4$Monat_c=="Juni")) %>%
  mutate(Juli=as.integer(df_lm_train_WG4$Monat_c=="Juli")) %>%
  mutate(August=as.integer(df_lm_train_WG4$Monat_c=="August")) %>%
  mutate(September=as.integer(df_lm_train_WG4$Monat_c=="September")) %>%
  mutate(Oktober=as.integer(df_lm_train_WG4$Monat_c=="Oktober")) %>%
  mutate(November=as.integer(df_lm_train_WG4$Monat_c=="November")) %>%
  mutate(Dezember=as.integer(df_lm_train_WG4$Monat_c=="Dezember")) %>%
  mutate(Fruehling=as.integer(df_lm_train_WG4$Jahreszeit=="Fruehling")) %>%
  mutate(Sommer=as.integer(df_lm_train_WG4$Jahreszeit=="Sommer")) %>%
  mutate(Herbst=as.integer(df_lm_train_WG4$Jahreszeit=="Herbst")) %>%
  mutate(Winter=as.integer(df_lm_train_WG4$Jahreszeit=="Winter")) %>%
  dplyr::select(-Wochentag_c, -Monat_c, -Jahreszeit)

df_lm_test_WG4_1 <- df_lm_test_WG4 %>%
  mutate(Montag=as.integer(df_lm_test_WG4$Wochentag_c=="Montag")) %>%
  mutate(Dienstag=as.integer(df_lm_test_WG4$Wochentag_c=="Dienstag")) %>%
  mutate(Mittwoch=as.integer(df_lm_test_WG4$Wochentag_c=="Mittwoch")) %>%
  mutate(Donnerstag=as.integer(df_lm_test_WG4$Wochentag_c=="Donnerstag")) %>%
  mutate(Freitag=as.integer(df_lm_test_WG4$Wochentag_c=="Freitag")) %>%
  mutate(Samstag=as.integer(df_lm_test_WG4$Wochentag_c=="Samstag")) %>%
  mutate(Sonntag=as.integer(df_lm_test_WG4$Wochentag_c=="Sonntag")) %>%
  mutate(Januar=as.integer(df_lm_test_WG4$Monat_c=="Januar")) %>%
  mutate(Februar=as.integer(df_lm_test_WG4$Monat_c=="Februar")) %>%
  mutate(Maerz=as.integer(df_lm_test_WG4$Monat_c=="März")) %>%
  mutate(April=as.integer(df_lm_test_WG4$Monat_c=="April")) %>%
  mutate(Mai=as.integer(df_lm_test_WG4$Monat_c=="Mai")) %>%
  mutate(Juni=as.integer(df_lm_test_WG4$Monat_c=="Juni")) %>%
  mutate(Juli=as.integer(df_lm_test_WG4$Monat_c=="Juli")) %>%
  mutate(August=as.integer(df_lm_test_WG4$Monat_c=="August")) %>%
  mutate(September=as.integer(df_lm_test_WG4$Monat_c=="September")) %>%
  mutate(Oktober=as.integer(df_lm_test_WG4$Monat_c=="Oktober")) %>%
  mutate(November=as.integer(df_lm_test_WG4$Monat_c=="November")) %>%
  mutate(Dezember=as.integer(df_lm_test_WG4$Monat_c=="Dezember")) %>%
  mutate(Fruehling=as.integer(df_lm_test_WG4$Jahreszeit=="Fruehling")) %>%
  mutate(Sommer=as.integer(df_lm_test_WG4$Jahreszeit=="Sommer")) %>%
  mutate(Herbst=as.integer(df_lm_test_WG4$Jahreszeit=="Herbst")) %>%
  mutate(Winter=as.integer(df_lm_test_WG4$Jahreszeit=="Winter")) %>%
  dplyr::select(-Wochentag_c, -Monat_c, -Jahreszeit)

Für das 1-Variablenmodell wird nun ein Regressionsmodell erstellt:

## # A tibble: 1 x 11
##   r.squared adj.r.squared sigma statistic  p.value    df logLik    AIC
##       <dbl>         <dbl> <dbl>     <dbl>    <dbl> <int>  <dbl>  <dbl>
## 1     0.270         0.269  30.0      386. 1.84e-73     2 -5045. 10095.
## # ... with 3 more variables: BIC <dbl>, deviance <dbl>, df.residual <int>

Dieses einfache Regressionsmodell hat einen vergleichweise schlechten \(R^2\)-Wert. Am Ende ist es wahrscheinlich zu einfach.

Dann wird (die Modellgüte) anhand der Test-Stichprobe getestet:

Als Ergebnis wird ein Vektor erzeugt, der für jede Beobachtung des Test-Samples den geschätzten (vorhergesagten) Umsatzwert speichert. Die Gütewerte lassen sich mit caret::postResample ausgeben:

##       RMSE   Rsquared        MAE 
## 22.9285469  0.1924832 17.6887745

Diese Vorhersage-Ergebnisse werden den Test-Daten hinzugefügt, sodann die Gütekennzahlen berechnet, die wiederum der gemeinsamen Übersichtstabelle für die Gütekennzahlen lm_vgl_kennz hinzugefügt werden:

# Hinzufügen der Ergebnisse
df_lm_test_WG4_1 <- df_lm_test_WG4_1 %>%
  mutate(predicted = lm_WG4_1_predict)

# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
df_lm_test_WG4_1 <-df_lm_test_WG4_1 %>%
  mutate(Prognose_zuhoch = (predicted >= Umsatz)) %>%
  mutate(Abweichung = predicted - Umsatz) %>%
  mutate(Abweichung_abs = abs(predicted - Umsatz)) %>%
  mutate(Abweichung_rel = (predicted - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Ergänze die benötigten Hilfsgrößen
df_lm_test_WG4_1 <- df_lm_test_WG4_1 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- df_lm_test_WG4_1 %>%
  group_by() %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz), 2), Umsatz_mittel = round(sum(Umsatz)/n(), 2), MAE = round(mean(Abweichung_abs), 2), MPE = round(mean(Abweichung_rel)*100, 2), MAPE = round(mean(Abweichung_rel_abs)*100, 2), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100, 2), MSE = round(mean(Abweichung_quad), 2), RMSE = round(sqrt(mean(Abweichung_quad)), 2), rRMSE = round(RMSE/Umsatz_mittel*100, 2))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "best1_WG4")

# füge die Kennzahlen nun an die Vergleichstabelle
lm_vgl_kennz <- rbind(lm_vgl_kennz, temp)
lm_vgl_kennz
## # A tibble: 11 x 11
##    Anzahl Umsatz_ges Umsatz_mittel   MAE   MPE  MAPE  WAPE   MSE  RMSE
##     <int>      <dbl>         <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
##  1    346     45738.         132.   24.8 -7.84  18.7  18.8 1067.  32.7
##  2    346     45738.         132.   24.8 -7.65  18.8  18.8 1064.  32.6
##  3    346     45738.         132.   24.7 -7.93  18.5  18.7 1050.  32.4
##  4    346     45738.         132.   24.7 -7.91  18.6  18.7 1050.  32.4
##  5    346    130413.         377.   39.8  3.37  11.4  10.6 2708.  52.0
##  6    346    130413.         377.   39.8  3.45  11.4  10.6 2722.  52.2
##  7    346    130413.         377.   40.3  3.48  11.6  10.7 2768.  52.6
##  8    346    130413.         377.   39.9  3.52  11.5  10.6 2720.  52.2
##  9    346     59316.         171.   31.2 -8.4   17.3  18.2 1751.  41.8
## 10    346     59316.         171.   30.9 -8.38  17.4  18.0 1722.  41.5
## 11    345     28354.          82.2  17.7 13.7   24.5  21.5  526.  22.9
## # ... with 2 more variables: rRMSE <dbl>, Modell <chr>

Teilmengenauswahl für das 11-Variablen-Modell

Die 11 Variablen sind die folgenden:

  • Wochentag_cSamstag
  • Wochentag_cSonntag
  • Monat_cFebruar
  • Monat_cJuli
  • Monat_cJuni
  • Feiertag
  • Ostern
  • ChristiHimmelfahrt
  • Pfingsten
  • TDE
  • JahreszeitSommer

Die Variablen Wochentag_c, Monat_c und Jahreszeit nun noch dummyfiziert werden (bei Einbeziehung aller Variablen erfolgt die Dummyfizierung automatisch im Rahmen der Regressionsanalyse): Für jeden Wochentag wird eine Variable mit Ausprägung 0/1 gebildet und danach die alte Variable Wochentag_c entfernt. Analog wird bei den beiden anderen Variablen vorgegangen.

# Dummyfizierung der Variablen im Trainigsdatensatz:
df_lm_train_WG4_11 <- df_lm_train_WG4 %>%
  mutate(Montag=as.integer(df_lm_train_WG4$Wochentag_c=="Montag")) %>%
  mutate(Dienstag=as.integer(df_lm_train_WG4$Wochentag_c=="Dienstag")) %>%
  mutate(Mittwoch=as.integer(df_lm_train_WG4$Wochentag_c=="Mittwoch")) %>%
  mutate(Donnerstag=as.integer(df_lm_train_WG4$Wochentag_c=="Donnerstag")) %>%
  mutate(Freitag=as.integer(df_lm_train_WG4$Wochentag_c=="Freitag")) %>%
  mutate(Samstag=as.integer(df_lm_train_WG4$Wochentag_c=="Samstag")) %>%
  mutate(Sonntag=as.integer(df_lm_train_WG4$Wochentag_c=="Sonntag")) %>%
  mutate(Januar=as.integer(df_lm_train_WG4$Monat_c=="Januar")) %>%
  mutate(Februar=as.integer(df_lm_train_WG4$Monat_c=="Februar")) %>%
  mutate(Maerz=as.integer(df_lm_train_WG4$Monat_c=="März")) %>%
  mutate(April=as.integer(df_lm_train_WG4$Monat_c=="April")) %>%
  mutate(Mai=as.integer(df_lm_train_WG4$Monat_c=="Mai")) %>%
  mutate(Juni=as.integer(df_lm_train_WG4$Monat_c=="Juni")) %>%
  mutate(Juli=as.integer(df_lm_train_WG4$Monat_c=="Juli")) %>%
  mutate(August=as.integer(df_lm_train_WG4$Monat_c=="August")) %>%
  mutate(September=as.integer(df_lm_train_WG4$Monat_c=="September")) %>%
  mutate(Oktober=as.integer(df_lm_train_WG4$Monat_c=="Oktober")) %>%
  mutate(November=as.integer(df_lm_train_WG4$Monat_c=="November")) %>%
  mutate(Dezember=as.integer(df_lm_train_WG4$Monat_c=="Dezember")) %>%
  mutate(Fruehling=as.integer(df_lm_train_WG4$Jahreszeit=="Fruehling")) %>%
  mutate(Sommer=as.integer(df_lm_train_WG4$Jahreszeit=="Sommer")) %>%
  mutate(Herbst=as.integer(df_lm_train_WG4$Jahreszeit=="Herbst")) %>%
  mutate(Winter=as.integer(df_lm_train_WG4$Jahreszeit=="Winter")) %>%
  dplyr::select(-Wochentag_c, -Monat_c, -Jahreszeit)

df_lm_test_WG4_11 <- df_lm_test_WG4 %>%
  mutate(Montag=as.integer(df_lm_test_WG4$Wochentag_c=="Montag")) %>%
  mutate(Dienstag=as.integer(df_lm_test_WG4$Wochentag_c=="Dienstag")) %>%
  mutate(Mittwoch=as.integer(df_lm_test_WG4$Wochentag_c=="Mittwoch")) %>%
  mutate(Donnerstag=as.integer(df_lm_test_WG4$Wochentag_c=="Donnerstag")) %>%
  mutate(Freitag=as.integer(df_lm_test_WG4$Wochentag_c=="Freitag")) %>%
  mutate(Samstag=as.integer(df_lm_test_WG4$Wochentag_c=="Samstag")) %>%
  mutate(Sonntag=as.integer(df_lm_test_WG4$Wochentag_c=="Sonntag")) %>%
  mutate(Januar=as.integer(df_lm_test_WG4$Monat_c=="Januar")) %>%
  mutate(Februar=as.integer(df_lm_test_WG4$Monat_c=="Februar")) %>%
  mutate(Maerz=as.integer(df_lm_test_WG4$Monat_c=="März")) %>%
  mutate(April=as.integer(df_lm_test_WG4$Monat_c=="April")) %>%
  mutate(Mai=as.integer(df_lm_test_WG4$Monat_c=="Mai")) %>%
  mutate(Juni=as.integer(df_lm_test_WG4$Monat_c=="Juni")) %>%
  mutate(Juli=as.integer(df_lm_test_WG4$Monat_c=="Juli")) %>%
  mutate(August=as.integer(df_lm_test_WG4$Monat_c=="August")) %>%
  mutate(September=as.integer(df_lm_test_WG4$Monat_c=="September")) %>%
  mutate(Oktober=as.integer(df_lm_test_WG4$Monat_c=="Oktober")) %>%
  mutate(November=as.integer(df_lm_test_WG4$Monat_c=="November")) %>%
  mutate(Dezember=as.integer(df_lm_test_WG4$Monat_c=="Dezember")) %>%
  mutate(Fruehling=as.integer(df_lm_test_WG4$Jahreszeit=="Fruehling")) %>%
  mutate(Sommer=as.integer(df_lm_test_WG4$Jahreszeit=="Sommer")) %>%
  mutate(Herbst=as.integer(df_lm_test_WG4$Jahreszeit=="Herbst")) %>%
  mutate(Winter=as.integer(df_lm_test_WG4$Jahreszeit=="Winter")) %>%
  dplyr::select(-Wochentag_c, -Monat_c, -Jahreszeit)

Für das 11-Variablenmodell wird nun ein Regressionsmodell erstellt:

## # A tibble: 1 x 11
##   r.squared adj.r.squared sigma statistic   p.value    df logLik   AIC
##       <dbl>         <dbl> <dbl>     <dbl>     <dbl> <int>  <dbl> <dbl>
## 1     0.443         0.437  26.3      74.9 1.78e-123    12 -4903. 9831.
## # ... with 3 more variables: BIC <dbl>, deviance <dbl>, df.residual <int>

Dann wird (die Modellgüte) anhand der Test-Stichprobe getestet:

Als Ergebnis wird ein Vektor erzeugt, der für jede Beobachtung des Test-Samples den geschätzten (vorhergesagten) Umsatzwert speichert. Die Gütewerte lassen sich mit caret::postResample ausgeben:

##       RMSE   Rsquared        MAE 
## 24.6401267  0.2090212 18.2669810

Diese Vorhersage-Ergebnisse werden den Test-Daten hinzugefügt, sodann die Gütekennzahlen berechnet, die wiederum der gemeinsamen Übersichtstabelle für die Gütekennzahlen lm_vgl_kennz hinzugefügt werden:

# Hinzufügen der Ergebnisse
df_lm_test_WG4_11 <- df_lm_test_WG4_11 %>%
  mutate(predicted = lm_WG4_11_predict)

# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
df_lm_test_WG4_11 <-df_lm_test_WG4_11 %>%
  mutate(Prognose_zuhoch = (predicted >= Umsatz)) %>%
  mutate(Abweichung = predicted - Umsatz) %>%
  mutate(Abweichung_abs = abs(predicted - Umsatz)) %>%
  mutate(Abweichung_rel = (predicted - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Ergänze die benötigten Hilfsgrößen
df_lm_test_WG4_11 <- df_lm_test_WG4_11 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- df_lm_test_WG4_11 %>%
  group_by() %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz), 2), Umsatz_mittel = round(sum(Umsatz)/n(), 2), MAE = round(mean(Abweichung_abs), 2), MPE = round(mean(Abweichung_rel)*100, 2), MAPE = round(mean(Abweichung_rel_abs)*100, 2), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100, 2), MSE = round(mean(Abweichung_quad), 2), RMSE = round(sqrt(mean(Abweichung_quad)), 2), rRMSE = round(RMSE/Umsatz_mittel*100, 2))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "best11_WG4")

# füge die Kennzahlen nun an die Vergleichstabelle
lm_vgl_kennz <- rbind(lm_vgl_kennz, temp)
lm_vgl_kennz
## # A tibble: 12 x 11
##    Anzahl Umsatz_ges Umsatz_mittel   MAE   MPE  MAPE  WAPE   MSE  RMSE
##     <int>      <dbl>         <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
##  1    346     45738.         132.   24.8 -7.84  18.7  18.8 1067.  32.7
##  2    346     45738.         132.   24.8 -7.65  18.8  18.8 1064.  32.6
##  3    346     45738.         132.   24.7 -7.93  18.5  18.7 1050.  32.4
##  4    346     45738.         132.   24.7 -7.91  18.6  18.7 1050.  32.4
##  5    346    130413.         377.   39.8  3.37  11.4  10.6 2708.  52.0
##  6    346    130413.         377.   39.8  3.45  11.4  10.6 2722.  52.2
##  7    346    130413.         377.   40.3  3.48  11.6  10.7 2768.  52.6
##  8    346    130413.         377.   39.9  3.52  11.5  10.6 2720.  52.2
##  9    346     59316.         171.   31.2 -8.4   17.3  18.2 1751.  41.8
## 10    346     59316.         171.   30.9 -8.38  17.4  18.0 1722.  41.5
## 11    345     28354.          82.2  17.7 13.7   24.5  21.5  526.  22.9
## 12    345     28354.          82.2  18.3 12.0   24.2  22.2  607.  24.6
## # ... with 2 more variables: rRMSE <dbl>, Modell <chr>

Teilmengenauswahl für das 20-Variablen-Modell nach best subset selection

Die 20 Variablen sind die folgenden:

  • Temperatur
  • Wochentag_cFreitag
  • Wochentag_cMontag
  • Wochentag_cSamstag
  • Wochentag_cSonntag
  • Monat_cDezember
  • Monat_cFebruar
  • Monat_cJuli
  • Monat_cJuni
  • Monat_cNovember
  • SommerferienSH
  • Feiertag
  • Ostern
  • ChristiHimmelfahrt
  • Pfingsten
  • TDE
  • ChristiHimmelfahrt_ext
  • Pfingsten_ext
  • JahreszeitHerbst
  • JahreszeitSommer

Die Variablen Wochentag_c, Monat_c und Jahreszeit nun noch dummyfiziert werden (bei Einbeziehung aller Variablen erfolgt die Dummyfizierung automatisch im Rahmen der Regressionsanalyse): Für jeden Wochentag wird eine Variable mit Ausprägung 0/1 gebildet und danach die alte Variable Wochentag_c entfernt. Analog wird bei den beiden anderen Variablen vorgegangen.

# Dummyfizierung der Variablen im Trainigsdatensatz:
df_lm_train_WG4_20 <- df_lm_train_WG4 %>%
  mutate(Montag=as.integer(df_lm_train_WG4$Wochentag_c=="Montag")) %>%
  mutate(Dienstag=as.integer(df_lm_train_WG4$Wochentag_c=="Dienstag")) %>%
  mutate(Mittwoch=as.integer(df_lm_train_WG4$Wochentag_c=="Mittwoch")) %>%
  mutate(Donnerstag=as.integer(df_lm_train_WG4$Wochentag_c=="Donnerstag")) %>%
  mutate(Freitag=as.integer(df_lm_train_WG4$Wochentag_c=="Freitag")) %>%
  mutate(Samstag=as.integer(df_lm_train_WG4$Wochentag_c=="Samstag")) %>%
  mutate(Sonntag=as.integer(df_lm_train_WG4$Wochentag_c=="Sonntag")) %>%
  mutate(Januar=as.integer(df_lm_train_WG4$Monat_c=="Januar")) %>%
  mutate(Februar=as.integer(df_lm_train_WG4$Monat_c=="Februar")) %>%
  mutate(Maerz=as.integer(df_lm_train_WG4$Monat_c=="März")) %>%
  mutate(April=as.integer(df_lm_train_WG4$Monat_c=="April")) %>%
  mutate(Mai=as.integer(df_lm_train_WG4$Monat_c=="Mai")) %>%
  mutate(Juni=as.integer(df_lm_train_WG4$Monat_c=="Juni")) %>%
  mutate(Juli=as.integer(df_lm_train_WG4$Monat_c=="Juli")) %>%
  mutate(August=as.integer(df_lm_train_WG4$Monat_c=="August")) %>%
  mutate(September=as.integer(df_lm_train_WG4$Monat_c=="September")) %>%
  mutate(Oktober=as.integer(df_lm_train_WG4$Monat_c=="Oktober")) %>%
  mutate(November=as.integer(df_lm_train_WG4$Monat_c=="November")) %>%
  mutate(Dezember=as.integer(df_lm_train_WG4$Monat_c=="Dezember")) %>%
  mutate(Fruehling=as.integer(df_lm_train_WG4$Jahreszeit=="Fruehling")) %>%
  mutate(Sommer=as.integer(df_lm_train_WG4$Jahreszeit=="Sommer")) %>%
  mutate(Herbst=as.integer(df_lm_train_WG4$Jahreszeit=="Herbst")) %>%
  mutate(Winter=as.integer(df_lm_train_WG4$Jahreszeit=="Winter")) %>%
  dplyr::select(-Wochentag_c, -Monat_c, -Jahreszeit)

df_lm_test_WG4_20 <- df_lm_test_WG4 %>%
  mutate(Montag=as.integer(df_lm_test_WG4$Wochentag_c=="Montag")) %>%
  mutate(Dienstag=as.integer(df_lm_test_WG4$Wochentag_c=="Dienstag")) %>%
  mutate(Mittwoch=as.integer(df_lm_test_WG4$Wochentag_c=="Mittwoch")) %>%
  mutate(Donnerstag=as.integer(df_lm_test_WG4$Wochentag_c=="Donnerstag")) %>%
  mutate(Freitag=as.integer(df_lm_test_WG4$Wochentag_c=="Freitag")) %>%
  mutate(Samstag=as.integer(df_lm_test_WG4$Wochentag_c=="Samstag")) %>%
  mutate(Sonntag=as.integer(df_lm_test_WG4$Wochentag_c=="Sonntag")) %>%
  mutate(Januar=as.integer(df_lm_test_WG4$Monat_c=="Januar")) %>%
  mutate(Februar=as.integer(df_lm_test_WG4$Monat_c=="Februar")) %>%
  mutate(Maerz=as.integer(df_lm_test_WG4$Monat_c=="März")) %>%
  mutate(April=as.integer(df_lm_test_WG4$Monat_c=="April")) %>%
  mutate(Mai=as.integer(df_lm_test_WG4$Monat_c=="Mai")) %>%
  mutate(Juni=as.integer(df_lm_test_WG4$Monat_c=="Juni")) %>%
  mutate(Juli=as.integer(df_lm_test_WG4$Monat_c=="Juli")) %>%
  mutate(August=as.integer(df_lm_test_WG4$Monat_c=="August")) %>%
  mutate(September=as.integer(df_lm_test_WG4$Monat_c=="September")) %>%
  mutate(Oktober=as.integer(df_lm_test_WG4$Monat_c=="Oktober")) %>%
  mutate(November=as.integer(df_lm_test_WG4$Monat_c=="November")) %>%
  mutate(Dezember=as.integer(df_lm_test_WG4$Monat_c=="Dezember")) %>%
  mutate(Fruehling=as.integer(df_lm_test_WG4$Jahreszeit=="Fruehling")) %>%
  mutate(Sommer=as.integer(df_lm_test_WG4$Jahreszeit=="Sommer")) %>%
  mutate(Herbst=as.integer(df_lm_test_WG4$Jahreszeit=="Herbst")) %>%
  mutate(Winter=as.integer(df_lm_test_WG4$Jahreszeit=="Winter")) %>%
  dplyr::select(-Wochentag_c, -Monat_c, -Jahreszeit)

Für das 20-Variablenmodell wird nun ein Regressionsmodell erstellt:

## # A tibble: 1 x 11
##   r.squared adj.r.squared sigma statistic   p.value    df logLik   AIC
##       <dbl>         <dbl> <dbl>     <dbl>     <dbl> <int>  <dbl> <dbl>
## 1     0.453         0.443  26.2      42.6 1.52e-119    21 -4893. 9830.
## # ... with 3 more variables: BIC <dbl>, deviance <dbl>, df.residual <int>

Dann wird (die Modellgüte) anhand der Test-Stichprobe getestet:

Als Ergebnis wird ein Vektor erzeugt, der für jede Beobachtung des Test-Samples den geschätzten (vorhergesagten) Umsatzwert speichert. Die Gütewerte lassen sich mit caret::postResample ausgeben:

##       RMSE   Rsquared        MAE 
## 24.3552623  0.2254455 18.1367153

Diese Vorhersage-Ergebnisse werden den Test-Daten hinzugefügt, sodann die Gütekennzahlen berechnet, die wiederum der gemeinsamen Übersichtstabelle für die Gütekennzahlen lm_vgl_kennz hinzugefügt werden:

# Hinzufügen der Ergebnisse
df_lm_test_WG4_20 <- df_lm_test_WG4_20 %>%
  mutate(predicted = lm_WG4_20_predict)

# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
df_lm_test_WG4_20 <-df_lm_test_WG4_20 %>%
  mutate(Prognose_zuhoch = (predicted >= Umsatz)) %>%
  mutate(Abweichung = predicted - Umsatz) %>%
  mutate(Abweichung_abs = abs(predicted - Umsatz)) %>%
  mutate(Abweichung_rel = (predicted - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Ergänze die benötigten Hilfsgrößen
df_lm_test_WG4_20 <- df_lm_test_WG4_20 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- df_lm_test_WG4_20 %>%
  group_by() %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz), 2), Umsatz_mittel = round(sum(Umsatz)/n(), 2), MAE = round(mean(Abweichung_abs), 2), MPE = round(mean(Abweichung_rel)*100, 2), MAPE = round(mean(Abweichung_rel_abs)*100, 2), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100, 2), MSE = round(mean(Abweichung_quad), 2), RMSE = round(sqrt(mean(Abweichung_quad)), 2), rRMSE = round(RMSE/Umsatz_mittel*100, 2))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "best20_WG4")

# füge die Kennzahlen nun an die Vergleichstabelle
lm_vgl_kennz <- rbind(lm_vgl_kennz, temp)
lm_vgl_kennz
## # A tibble: 13 x 11
##    Anzahl Umsatz_ges Umsatz_mittel   MAE   MPE  MAPE  WAPE   MSE  RMSE
##     <int>      <dbl>         <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
##  1    346     45738.         132.   24.8 -7.84  18.7  18.8 1067.  32.7
##  2    346     45738.         132.   24.8 -7.65  18.8  18.8 1064.  32.6
##  3    346     45738.         132.   24.7 -7.93  18.5  18.7 1050.  32.4
##  4    346     45738.         132.   24.7 -7.91  18.6  18.7 1050.  32.4
##  5    346    130413.         377.   39.8  3.37  11.4  10.6 2708.  52.0
##  6    346    130413.         377.   39.8  3.45  11.4  10.6 2722.  52.2
##  7    346    130413.         377.   40.3  3.48  11.6  10.7 2768.  52.6
##  8    346    130413.         377.   39.9  3.52  11.5  10.6 2720.  52.2
##  9    346     59316.         171.   31.2 -8.4   17.3  18.2 1751.  41.8
## 10    346     59316.         171.   30.9 -8.38  17.4  18.0 1722.  41.5
## 11    345     28354.          82.2  17.7 13.7   24.5  21.5  526.  22.9
## 12    345     28354.          82.2  18.3 12.0   24.2  22.2  607.  24.6
## 13    345     28354.          82.2  18.1 11.6   23.8  22.1  593.  24.4
## # ... with 2 more variables: rRMSE <dbl>, Modell <chr>

Teilmengenauswahl für das 18-Variablen-Modell gemäß forward selection

Die 18 Variablen sind die folgenden:

  • Temperatur
  • Wochentag_cDonnerstag
  • Wochentag_cMittwoch
  • Wochentag_cSamstag
  • Wochentag_cSonntag
  • Monat_cAugust
  • Monat_cFebruar
  • Monat_cJuni
  • Monat_cOktober
  • Monat_cSeptember
  • Feiertag
  • Ostern
  • ChristiHimmelfahrt
  • Pfingsten
  • TDE
  • ChristiHimmelfahrt_ext
  • Pfingsten_ext
  • Silvester_ext Die VariablenWochentag_c,Monat_cundJahreszeitnun noch dummyfiziert werden (bei Einbeziehung aller Variablen erfolgt die Dummyfizierung automatisch im Rahmen der Regressionsanalyse): Für jeden Wochentag wird eine Variable mit Ausprägung 0/1 gebildet und danach die alte VariableWochentag_c` entfernt. Analog wird bei den beiden anderen Variablen vorgegangen.
# Dummyfizierung der Variablen im Trainigsdatensatz:
df_lm_train_WG4_18 <- df_lm_train_WG4 %>%
  mutate(Montag=as.integer(df_lm_train_WG4$Wochentag_c=="Montag")) %>%
  mutate(Dienstag=as.integer(df_lm_train_WG4$Wochentag_c=="Dienstag")) %>%
  mutate(Mittwoch=as.integer(df_lm_train_WG4$Wochentag_c=="Mittwoch")) %>%
  mutate(Donnerstag=as.integer(df_lm_train_WG4$Wochentag_c=="Donnerstag")) %>%
  mutate(Freitag=as.integer(df_lm_train_WG4$Wochentag_c=="Freitag")) %>%
  mutate(Samstag=as.integer(df_lm_train_WG4$Wochentag_c=="Samstag")) %>%
  mutate(Sonntag=as.integer(df_lm_train_WG4$Wochentag_c=="Sonntag")) %>%
  mutate(Januar=as.integer(df_lm_train_WG4$Monat_c=="Januar")) %>%
  mutate(Februar=as.integer(df_lm_train_WG4$Monat_c=="Februar")) %>%
  mutate(Maerz=as.integer(df_lm_train_WG4$Monat_c=="März")) %>%
  mutate(April=as.integer(df_lm_train_WG4$Monat_c=="April")) %>%
  mutate(Mai=as.integer(df_lm_train_WG4$Monat_c=="Mai")) %>%
  mutate(Juni=as.integer(df_lm_train_WG4$Monat_c=="Juni")) %>%
  mutate(Juli=as.integer(df_lm_train_WG4$Monat_c=="Juli")) %>%
  mutate(August=as.integer(df_lm_train_WG4$Monat_c=="August")) %>%
  mutate(September=as.integer(df_lm_train_WG4$Monat_c=="September")) %>%
  mutate(Oktober=as.integer(df_lm_train_WG4$Monat_c=="Oktober")) %>%
  mutate(November=as.integer(df_lm_train_WG4$Monat_c=="November")) %>%
  mutate(Dezember=as.integer(df_lm_train_WG4$Monat_c=="Dezember")) %>%
  mutate(Fruehling=as.integer(df_lm_train_WG4$Jahreszeit=="Fruehling")) %>%
  mutate(Sommer=as.integer(df_lm_train_WG4$Jahreszeit=="Sommer")) %>%
  mutate(Herbst=as.integer(df_lm_train_WG4$Jahreszeit=="Herbst")) %>%
  mutate(Winter=as.integer(df_lm_train_WG4$Jahreszeit=="Winter")) %>%
  dplyr::select(-Wochentag_c, -Monat_c, -Jahreszeit)

df_lm_test_WG4_18 <- df_lm_test_WG4 %>%
  mutate(Montag=as.integer(df_lm_test_WG4$Wochentag_c=="Montag")) %>%
  mutate(Dienstag=as.integer(df_lm_test_WG4$Wochentag_c=="Dienstag")) %>%
  mutate(Mittwoch=as.integer(df_lm_test_WG4$Wochentag_c=="Mittwoch")) %>%
  mutate(Donnerstag=as.integer(df_lm_test_WG4$Wochentag_c=="Donnerstag")) %>%
  mutate(Freitag=as.integer(df_lm_test_WG4$Wochentag_c=="Freitag")) %>%
  mutate(Samstag=as.integer(df_lm_test_WG4$Wochentag_c=="Samstag")) %>%
  mutate(Sonntag=as.integer(df_lm_test_WG4$Wochentag_c=="Sonntag")) %>%
  mutate(Januar=as.integer(df_lm_test_WG4$Monat_c=="Januar")) %>%
  mutate(Februar=as.integer(df_lm_test_WG4$Monat_c=="Februar")) %>%
  mutate(Maerz=as.integer(df_lm_test_WG4$Monat_c=="März")) %>%
  mutate(April=as.integer(df_lm_test_WG4$Monat_c=="April")) %>%
  mutate(Mai=as.integer(df_lm_test_WG4$Monat_c=="Mai")) %>%
  mutate(Juni=as.integer(df_lm_test_WG4$Monat_c=="Juni")) %>%
  mutate(Juli=as.integer(df_lm_test_WG4$Monat_c=="Juli")) %>%
  mutate(August=as.integer(df_lm_test_WG4$Monat_c=="August")) %>%
  mutate(September=as.integer(df_lm_test_WG4$Monat_c=="September")) %>%
  mutate(Oktober=as.integer(df_lm_test_WG4$Monat_c=="Oktober")) %>%
  mutate(November=as.integer(df_lm_test_WG4$Monat_c=="November")) %>%
  mutate(Dezember=as.integer(df_lm_test_WG4$Monat_c=="Dezember")) %>%
  mutate(Fruehling=as.integer(df_lm_test_WG4$Jahreszeit=="Fruehling")) %>%
  mutate(Sommer=as.integer(df_lm_test_WG4$Jahreszeit=="Sommer")) %>%
  mutate(Herbst=as.integer(df_lm_test_WG4$Jahreszeit=="Herbst")) %>%
  mutate(Winter=as.integer(df_lm_test_WG4$Jahreszeit=="Winter")) %>%
  dplyr::select(-Wochentag_c, -Monat_c, -Jahreszeit)

Für das 18-Variablenmodell wird nun ein Regressionsmodell erstellt:

## # A tibble: 1 x 11
##   r.squared adj.r.squared sigma statistic   p.value    df logLik   AIC
##       <dbl>         <dbl> <dbl>     <dbl>     <dbl> <int>  <dbl> <dbl>
## 1     0.451         0.441  26.2      46.9 3.98e-120    19 -4896. 9831.
## # ... with 3 more variables: BIC <dbl>, deviance <dbl>, df.residual <int>

Dann wird (die Modellgüte) anhand der Test-Stichprobe getestet:

Als Ergebnis wird ein Vektor erzeugt, der für jede Beobachtung des Test-Samples den geschätzten (vorhergesagten) Umsatzwert speichert. Die Gütewerte lassen sich mit caret::postResample ausgeben:

##       RMSE   Rsquared        MAE 
## 24.4829122  0.2245706 18.2475726

Diese Vorhersage-Ergebnisse werden den Test-Daten hinzugefügt, sodann die Gütekennzahlen berechnet, die wiederum der gemeinsamen Übersichtstabelle für die Gütekennzahlen lm_vgl_kennz hinzugefügt werden:

# Hinzufügen der Ergebnisse
df_lm_test_WG4_18 <- df_lm_test_WG4_18 %>%
  mutate(predicted = lm_WG4_18_predict)

# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
df_lm_test_WG4_18 <-df_lm_test_WG4_18 %>%
  mutate(Prognose_zuhoch = (predicted >= Umsatz)) %>%
  mutate(Abweichung = predicted - Umsatz) %>%
  mutate(Abweichung_abs = abs(predicted - Umsatz)) %>%
  mutate(Abweichung_rel = (predicted - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Ergänze die benötigten Hilfsgrößen
df_lm_test_WG4_18 <- df_lm_test_WG4_18 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- df_lm_test_WG4_18 %>%
  group_by() %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz), 2), Umsatz_mittel = round(sum(Umsatz)/n(), 2), MAE = round(mean(Abweichung_abs), 2), MPE = round(mean(Abweichung_rel)*100, 2), MAPE = round(mean(Abweichung_rel_abs)*100, 2), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100, 2), MSE = round(mean(Abweichung_quad), 2), RMSE = round(sqrt(mean(Abweichung_quad)), 2), rRMSE = round(RMSE/Umsatz_mittel*100, 2))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "best18_WG4")

# füge die Kennzahlen nun an die Vergleichstabelle
lm_vgl_kennz <- rbind(lm_vgl_kennz, temp)
lm_vgl_kennz
## # A tibble: 14 x 11
##    Anzahl Umsatz_ges Umsatz_mittel   MAE   MPE  MAPE  WAPE   MSE  RMSE
##     <int>      <dbl>         <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
##  1    346     45738.         132.   24.8 -7.84  18.7  18.8 1067.  32.7
##  2    346     45738.         132.   24.8 -7.65  18.8  18.8 1064.  32.6
##  3    346     45738.         132.   24.7 -7.93  18.5  18.7 1050.  32.4
##  4    346     45738.         132.   24.7 -7.91  18.6  18.7 1050.  32.4
##  5    346    130413.         377.   39.8  3.37  11.4  10.6 2708.  52.0
##  6    346    130413.         377.   39.8  3.45  11.4  10.6 2722.  52.2
##  7    346    130413.         377.   40.3  3.48  11.6  10.7 2768.  52.6
##  8    346    130413.         377.   39.9  3.52  11.5  10.6 2720.  52.2
##  9    346     59316.         171.   31.2 -8.4   17.3  18.2 1751.  41.8
## 10    346     59316.         171.   30.9 -8.38  17.4  18.0 1722.  41.5
## 11    345     28354.          82.2  17.7 13.7   24.5  21.5  526.  22.9
## 12    345     28354.          82.2  18.3 12.0   24.2  22.2  607.  24.6
## 13    345     28354.          82.2  18.1 11.6   23.8  22.1  593.  24.4
## 14    345     28354.          82.2  18.2 11.5   23.9  22.2  599.  24.5
## # ... with 2 more variables: rRMSE <dbl>, Modell <chr>

Teilmengenauswahl für das 15-Variablen-Modell gemäß backward selection

Die 15 Variablen sind die folgenden:

  • Wochentag_cFreitag
  • Wochentag_cMontag
  • Wochentag_cSamstag
  • Wochentag_cSonntag
  • Monat_cFebruar
  • Monat_cJuli
  • Monat_cJuni
  • SommerferienSH
  • Feiertag
  • Ostern
  • ChristiHimmelfahrt
  • Pfingsten
  • TDE
  • JahreszeitHerbst
  • JahreszeitSommer

Die Variablen Wochentag_c, Monat_c und Jahreszeit nun noch dummyfiziert werden (bei Einbeziehung aller Variablen erfolgt die Dummyfizierung automatisch im Rahmen der Regressionsanalyse): Für jeden Wochentag wird eine Variable mit Ausprägung 0/1 gebildet und danach die alte Variable Wochentag_c entfernt. Analog wird bei den beiden anderen Variablen vorgegangen.

# Dummyfizierung der Variablen im Trainigsdatensatz:
df_lm_train_WG4_15 <- df_lm_train_WG4 %>%
  mutate(Montag=as.integer(df_lm_train_WG4$Wochentag_c=="Montag")) %>%
  mutate(Dienstag=as.integer(df_lm_train_WG4$Wochentag_c=="Dienstag")) %>%
  mutate(Mittwoch=as.integer(df_lm_train_WG4$Wochentag_c=="Mittwoch")) %>%
  mutate(Donnerstag=as.integer(df_lm_train_WG4$Wochentag_c=="Donnerstag")) %>%
  mutate(Freitag=as.integer(df_lm_train_WG4$Wochentag_c=="Freitag")) %>%
  mutate(Samstag=as.integer(df_lm_train_WG4$Wochentag_c=="Samstag")) %>%
  mutate(Sonntag=as.integer(df_lm_train_WG4$Wochentag_c=="Sonntag")) %>%
  mutate(Januar=as.integer(df_lm_train_WG4$Monat_c=="Januar")) %>%
  mutate(Februar=as.integer(df_lm_train_WG4$Monat_c=="Februar")) %>%
  mutate(Maerz=as.integer(df_lm_train_WG4$Monat_c=="März")) %>%
  mutate(April=as.integer(df_lm_train_WG4$Monat_c=="April")) %>%
  mutate(Mai=as.integer(df_lm_train_WG4$Monat_c=="Mai")) %>%
  mutate(Juni=as.integer(df_lm_train_WG4$Monat_c=="Juni")) %>%
  mutate(Juli=as.integer(df_lm_train_WG4$Monat_c=="Juli")) %>%
  mutate(August=as.integer(df_lm_train_WG4$Monat_c=="August")) %>%
  mutate(September=as.integer(df_lm_train_WG4$Monat_c=="September")) %>%
  mutate(Oktober=as.integer(df_lm_train_WG4$Monat_c=="Oktober")) %>%
  mutate(November=as.integer(df_lm_train_WG4$Monat_c=="November")) %>%
  mutate(Dezember=as.integer(df_lm_train_WG4$Monat_c=="Dezember")) %>%
  mutate(Fruehling=as.integer(df_lm_train_WG4$Jahreszeit=="Fruehling")) %>%
  mutate(Sommer=as.integer(df_lm_train_WG4$Jahreszeit=="Sommer")) %>%
  mutate(Herbst=as.integer(df_lm_train_WG4$Jahreszeit=="Herbst")) %>%
  mutate(Winter=as.integer(df_lm_train_WG4$Jahreszeit=="Winter")) %>%
  dplyr::select(-Wochentag_c, -Monat_c, -Jahreszeit)

df_lm_test_WG4_15 <- df_lm_test_WG4 %>%
  mutate(Montag=as.integer(df_lm_test_WG4$Wochentag_c=="Montag")) %>%
  mutate(Dienstag=as.integer(df_lm_test_WG4$Wochentag_c=="Dienstag")) %>%
  mutate(Mittwoch=as.integer(df_lm_test_WG4$Wochentag_c=="Mittwoch")) %>%
  mutate(Donnerstag=as.integer(df_lm_test_WG4$Wochentag_c=="Donnerstag")) %>%
  mutate(Freitag=as.integer(df_lm_test_WG4$Wochentag_c=="Freitag")) %>%
  mutate(Samstag=as.integer(df_lm_test_WG4$Wochentag_c=="Samstag")) %>%
  mutate(Sonntag=as.integer(df_lm_test_WG4$Wochentag_c=="Sonntag")) %>%
  mutate(Januar=as.integer(df_lm_test_WG4$Monat_c=="Januar")) %>%
  mutate(Februar=as.integer(df_lm_test_WG4$Monat_c=="Februar")) %>%
  mutate(Maerz=as.integer(df_lm_test_WG4$Monat_c=="März")) %>%
  mutate(April=as.integer(df_lm_test_WG4$Monat_c=="April")) %>%
  mutate(Mai=as.integer(df_lm_test_WG4$Monat_c=="Mai")) %>%
  mutate(Juni=as.integer(df_lm_test_WG4$Monat_c=="Juni")) %>%
  mutate(Juli=as.integer(df_lm_test_WG4$Monat_c=="Juli")) %>%
  mutate(August=as.integer(df_lm_test_WG4$Monat_c=="August")) %>%
  mutate(September=as.integer(df_lm_test_WG4$Monat_c=="September")) %>%
  mutate(Oktober=as.integer(df_lm_test_WG4$Monat_c=="Oktober")) %>%
  mutate(November=as.integer(df_lm_test_WG4$Monat_c=="November")) %>%
  mutate(Dezember=as.integer(df_lm_test_WG4$Monat_c=="Dezember")) %>%
  mutate(Fruehling=as.integer(df_lm_test_WG4$Jahreszeit=="Fruehling")) %>%
  mutate(Sommer=as.integer(df_lm_test_WG4$Jahreszeit=="Sommer")) %>%
  mutate(Herbst=as.integer(df_lm_test_WG4$Jahreszeit=="Herbst")) %>%
  mutate(Winter=as.integer(df_lm_test_WG4$Jahreszeit=="Winter")) %>%
  dplyr::select(-Wochentag_c, -Monat_c, -Jahreszeit)

Für das 15-Variablenmodell wird nun ein Regressionsmodell erstellt:

## # A tibble: 1 x 11
##   r.squared adj.r.squared sigma statistic   p.value    df logLik   AIC
##       <dbl>         <dbl> <dbl>     <dbl>     <dbl> <int>  <dbl> <dbl>
## 1     0.450         0.442  26.2      56.1 2.77e-122    16 -4897. 9827.
## # ... with 3 more variables: BIC <dbl>, deviance <dbl>, df.residual <int>

Dann wird (die Modellgüte) anhand der Test-Stichprobe getestet:

Als Ergebnis wird ein Vektor erzeugt, der für jede Beobachtung des Test-Samples den geschätzten (vorhergesagten) Umsatzwert speichert. Die Gütewerte lassen sich mit caret::postResample ausgeben:

##      RMSE  Rsquared       MAE 
## 24.583698  0.212243 18.357862

Diese Vorhersage-Ergebnisse werden den Test-Daten hinzugefügt, sodann die Gütekennzahlen berechnet, die wiederum der gemeinsamen Übersichtstabelle für die Gütekennzahlen lm_vgl_kennz hinzugefügt werden:

# Hinzufügen der Ergebnisse
df_lm_test_WG4_15 <- df_lm_test_WG4_15 %>%
  mutate(predicted = lm_WG4_15_predict)

# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
df_lm_test_WG4_15 <-df_lm_test_WG4_15 %>%
  mutate(Prognose_zuhoch = (predicted >= Umsatz)) %>%
  mutate(Abweichung = predicted - Umsatz) %>%
  mutate(Abweichung_abs = abs(predicted - Umsatz)) %>%
  mutate(Abweichung_rel = (predicted - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Ergänze die benötigten Hilfsgrößen
df_lm_test_WG4_15 <- df_lm_test_WG4_15 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- df_lm_test_WG4_15 %>%
  group_by() %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz), 2), Umsatz_mittel = round(sum(Umsatz)/n(), 2), MAE = round(mean(Abweichung_abs), 2), MPE = round(mean(Abweichung_rel)*100, 2), MAPE = round(mean(Abweichung_rel_abs)*100, 2), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100, 2), MSE = round(mean(Abweichung_quad), 2), RMSE = round(sqrt(mean(Abweichung_quad)), 2), rRMSE = round(RMSE/Umsatz_mittel*100, 2))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "best15_WG4")

# füge die Kennzahlen nun an die Vergleichstabelle
lm_vgl_kennz <- rbind(lm_vgl_kennz, temp)
lm_vgl_kennz
## # A tibble: 15 x 11
##    Anzahl Umsatz_ges Umsatz_mittel   MAE   MPE  MAPE  WAPE   MSE  RMSE
##     <int>      <dbl>         <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
##  1    346     45738.         132.   24.8 -7.84  18.7  18.8 1067.  32.7
##  2    346     45738.         132.   24.8 -7.65  18.8  18.8 1064.  32.6
##  3    346     45738.         132.   24.7 -7.93  18.5  18.7 1050.  32.4
##  4    346     45738.         132.   24.7 -7.91  18.6  18.7 1050.  32.4
##  5    346    130413.         377.   39.8  3.37  11.4  10.6 2708.  52.0
##  6    346    130413.         377.   39.8  3.45  11.4  10.6 2722.  52.2
##  7    346    130413.         377.   40.3  3.48  11.6  10.7 2768.  52.6
##  8    346    130413.         377.   39.9  3.52  11.5  10.6 2720.  52.2
##  9    346     59316.         171.   31.2 -8.4   17.3  18.2 1751.  41.8
## 10    346     59316.         171.   30.9 -8.38  17.4  18.0 1722.  41.5
## 11    345     28354.          82.2  17.7 13.7   24.5  21.5  526.  22.9
## 12    345     28354.          82.2  18.3 12.0   24.2  22.2  607.  24.6
## 13    345     28354.          82.2  18.1 11.6   23.8  22.1  593.  24.4
## 14    345     28354.          82.2  18.2 11.5   23.9  22.2  599.  24.5
## 15    345     28354.          82.2  18.4 12.1   24.2  22.3  604.  24.6
## # ... with 2 more variables: rRMSE <dbl>, Modell <chr>

Auch bei Warengruppe 4 gibt es nur sehr marginale unterschiede zwischen den einzelnen modellen. Selbst das 1-Variablen-Modell performt vergleichsweise gut. Der Sonntag scheint somit der ausschlaggebende Prädiktor für den Umsatz in der Warengruppe 4 zu sein. Das 18- und das 20-Variablen-Modell performen nahezu identisch. Da eine eindeutige Entscheidung zwischen dem 1-Variablen-Modell und dem 20-Variablen-Modell nicht möglich ist, wird an dieser Stelle das sehr schlanke Modell bevorzugt.

6.3.5 Warengruppe 5

Erstellung von Trainings- und Testdatensätzen für Warengruppe 5

Auswahl der am besten geeigneten Variablen Was die Vorgehensweise und die enstsprechenden Erläuterungen anbelangt, siehe 6.3.1.

Beste Teilmengenauswahl (“Best subset selection”)

Die regsubsets-Funktion gibt ein Listenobjekt mit vielen Informationen zurück. Zunächst kann der Befehl summary verwendet, um den besten Satz von Variablen für jede Modellgröße zu ermitteln.

## Subset selection object
## Call: regsubsets.formula(Umsatz ~ ., df_lm_train_WG5, nvmax = 37)
## 37 Variables  (and intercept)
##                        Forced in Forced out
## KielerWoche                FALSE      FALSE
## Bewoelkung                 FALSE      FALSE
## Temperatur                 FALSE      FALSE
## Windgeschwindigkeit        FALSE      FALSE
## Wochentag_cDonnerstag      FALSE      FALSE
## Wochentag_cFreitag         FALSE      FALSE
## Wochentag_cMittwoch        FALSE      FALSE
## Wochentag_cMontag          FALSE      FALSE
## Wochentag_cSamstag         FALSE      FALSE
## Wochentag_cSonntag         FALSE      FALSE
## Monat_cAugust              FALSE      FALSE
## Monat_cDezember            FALSE      FALSE
## Monat_cFebruar             FALSE      FALSE
## Monat_cJanuar              FALSE      FALSE
## Monat_cJuli                FALSE      FALSE
## Monat_cJuni                FALSE      FALSE
## Monat_cMai                 FALSE      FALSE
## Monat_cMärz                FALSE      FALSE
## Monat_cNovember            FALSE      FALSE
## Monat_cOktober             FALSE      FALSE
## Monat_cSeptember           FALSE      FALSE
## SommerferienSH             FALSE      FALSE
## SommerferienNRW            FALSE      FALSE
## SommerferienNDS            FALSE      FALSE
## SommerferienHE             FALSE      FALSE
## Feiertag                   FALSE      FALSE
## Ostern                     FALSE      FALSE
## ChristiHimmelfahrt         FALSE      FALSE
## Pfingsten                  FALSE      FALSE
## TDE                        FALSE      FALSE
## Ostern_ext                 FALSE      FALSE
## ChristiHimmelfahrt_ext     FALSE      FALSE
## Pfingsten_ext              FALSE      FALSE
## Silvester_ext              FALSE      FALSE
## JahreszeitHerbst           FALSE      FALSE
## JahreszeitSommer           FALSE      FALSE
## JahreszeitWinter           FALSE      FALSE
## 1 subsets of each size up to 37
## Selection Algorithm: exhaustive
##           KielerWoche Bewoelkung Temperatur Windgeschwindigkeit
## 1  ( 1 )  " "         " "        " "        " "                
## 2  ( 1 )  " "         " "        " "        " "                
## 3  ( 1 )  " "         " "        " "        " "                
## 4  ( 1 )  " "         " "        " "        " "                
## 5  ( 1 )  " "         " "        " "        " "                
## 6  ( 1 )  " "         " "        " "        " "                
## 7  ( 1 )  " "         " "        " "        " "                
## 8  ( 1 )  " "         " "        " "        " "                
## 9  ( 1 )  " "         " "        " "        " "                
## 10  ( 1 ) " "         " "        " "        " "                
## 11  ( 1 ) " "         " "        " "        " "                
## 12  ( 1 ) " "         " "        " "        " "                
## 13  ( 1 ) " "         " "        " "        " "                
## 14  ( 1 ) " "         " "        " "        " "                
## 15  ( 1 ) " "         " "        " "        " "                
## 16  ( 1 ) " "         " "        " "        " "                
## 17  ( 1 ) " "         " "        " "        " "                
## 18  ( 1 ) " "         " "        "*"        " "                
## 19  ( 1 ) " "         " "        "*"        " "                
## 20  ( 1 ) " "         " "        "*"        " "                
## 21  ( 1 ) " "         " "        "*"        " "                
## 22  ( 1 ) " "         " "        "*"        " "                
## 23  ( 1 ) " "         " "        "*"        " "                
## 24  ( 1 ) " "         " "        "*"        " "                
## 25  ( 1 ) " "         "*"        "*"        " "                
## 26  ( 1 ) " "         "*"        "*"        " "                
## 27  ( 1 ) "*"         "*"        "*"        " "                
## 28  ( 1 ) "*"         "*"        "*"        "*"                
## 29  ( 1 ) "*"         "*"        "*"        "*"                
## 30  ( 1 ) "*"         "*"        "*"        "*"                
## 31  ( 1 ) "*"         "*"        "*"        "*"                
## 32  ( 1 ) "*"         "*"        "*"        "*"                
## 33  ( 1 ) "*"         "*"        "*"        "*"                
## 34  ( 1 ) "*"         "*"        "*"        "*"                
## 35  ( 1 ) "*"         "*"        "*"        "*"                
## 36  ( 1 ) "*"         "*"        "*"        "*"                
## 37  ( 1 ) "*"         "*"        "*"        "*"                
##           Wochentag_cDonnerstag Wochentag_cFreitag Wochentag_cMittwoch
## 1  ( 1 )  " "                   " "                " "                
## 2  ( 1 )  " "                   " "                " "                
## 3  ( 1 )  " "                   " "                " "                
## 4  ( 1 )  " "                   " "                " "                
## 5  ( 1 )  " "                   " "                " "                
## 6  ( 1 )  " "                   " "                " "                
## 7  ( 1 )  " "                   " "                " "                
## 8  ( 1 )  " "                   " "                " "                
## 9  ( 1 )  " "                   " "                " "                
## 10  ( 1 ) " "                   " "                " "                
## 11  ( 1 ) " "                   " "                " "                
## 12  ( 1 ) " "                   " "                " "                
## 13  ( 1 ) " "                   " "                " "                
## 14  ( 1 ) " "                   " "                " "                
## 15  ( 1 ) " "                   "*"                " "                
## 16  ( 1 ) " "                   "*"                " "                
## 17  ( 1 ) " "                   "*"                " "                
## 18  ( 1 ) " "                   "*"                " "                
## 19  ( 1 ) " "                   "*"                " "                
## 20  ( 1 ) " "                   "*"                " "                
## 21  ( 1 ) " "                   "*"                " "                
## 22  ( 1 ) " "                   "*"                " "                
## 23  ( 1 ) " "                   "*"                " "                
## 24  ( 1 ) " "                   "*"                " "                
## 25  ( 1 ) " "                   "*"                " "                
## 26  ( 1 ) " "                   "*"                " "                
## 27  ( 1 ) " "                   "*"                " "                
## 28  ( 1 ) " "                   "*"                " "                
## 29  ( 1 ) " "                   "*"                " "                
## 30  ( 1 ) " "                   "*"                " "                
## 31  ( 1 ) " "                   "*"                " "                
## 32  ( 1 ) " "                   "*"                " "                
## 33  ( 1 ) " "                   "*"                " "                
## 34  ( 1 ) " "                   "*"                " "                
## 35  ( 1 ) "*"                   "*"                "*"                
## 36  ( 1 ) "*"                   "*"                "*"                
## 37  ( 1 ) "*"                   "*"                "*"                
##           Wochentag_cMontag Wochentag_cSamstag Wochentag_cSonntag
## 1  ( 1 )  " "               " "                " "               
## 2  ( 1 )  " "               " "                " "               
## 3  ( 1 )  " "               " "                " "               
## 4  ( 1 )  " "               "*"                " "               
## 5  ( 1 )  " "               " "                " "               
## 6  ( 1 )  " "               " "                " "               
## 7  ( 1 )  " "               "*"                " "               
## 8  ( 1 )  " "               "*"                "*"               
## 9  ( 1 )  " "               "*"                "*"               
## 10  ( 1 ) " "               "*"                "*"               
## 11  ( 1 ) " "               "*"                "*"               
## 12  ( 1 ) " "               "*"                "*"               
## 13  ( 1 ) " "               "*"                "*"               
## 14  ( 1 ) " "               "*"                "*"               
## 15  ( 1 ) " "               "*"                "*"               
## 16  ( 1 ) "*"               "*"                "*"               
## 17  ( 1 ) "*"               "*"                "*"               
## 18  ( 1 ) " "               "*"                "*"               
## 19  ( 1 ) "*"               "*"                "*"               
## 20  ( 1 ) "*"               "*"                "*"               
## 21  ( 1 ) " "               "*"                "*"               
## 22  ( 1 ) " "               "*"                "*"               
## 23  ( 1 ) "*"               "*"                "*"               
## 24  ( 1 ) "*"               "*"                "*"               
## 25  ( 1 ) "*"               "*"                "*"               
## 26  ( 1 ) "*"               "*"                "*"               
## 27  ( 1 ) "*"               "*"                "*"               
## 28  ( 1 ) "*"               "*"                "*"               
## 29  ( 1 ) "*"               "*"                "*"               
## 30  ( 1 ) "*"               "*"                "*"               
## 31  ( 1 ) "*"               "*"                "*"               
## 32  ( 1 ) "*"               "*"                "*"               
## 33  ( 1 ) "*"               "*"                "*"               
## 34  ( 1 ) "*"               "*"                "*"               
## 35  ( 1 ) "*"               "*"                "*"               
## 36  ( 1 ) "*"               "*"                "*"               
## 37  ( 1 ) "*"               "*"                "*"               
##           Monat_cAugust Monat_cDezember Monat_cFebruar Monat_cJanuar
## 1  ( 1 )  " "           " "             " "            " "          
## 2  ( 1 )  " "           " "             " "            " "          
## 3  ( 1 )  " "           " "             " "            " "          
## 4  ( 1 )  " "           " "             " "            " "          
## 5  ( 1 )  " "           " "             " "            " "          
## 6  ( 1 )  " "           " "             " "            " "          
## 7  ( 1 )  " "           " "             " "            " "          
## 8  ( 1 )  " "           " "             " "            " "          
## 9  ( 1 )  " "           " "             " "            " "          
## 10  ( 1 ) " "           "*"             " "            " "          
## 11  ( 1 ) " "           "*"             " "            " "          
## 12  ( 1 ) " "           "*"             " "            " "          
## 13  ( 1 ) " "           "*"             " "            " "          
## 14  ( 1 ) " "           "*"             "*"            " "          
## 15  ( 1 ) " "           "*"             "*"            " "          
## 16  ( 1 ) " "           "*"             "*"            " "          
## 17  ( 1 ) " "           "*"             "*"            " "          
## 18  ( 1 ) " "           "*"             "*"            " "          
## 19  ( 1 ) " "           "*"             "*"            " "          
## 20  ( 1 ) " "           "*"             "*"            " "          
## 21  ( 1 ) "*"           "*"             "*"            " "          
## 22  ( 1 ) "*"           "*"             "*"            " "          
## 23  ( 1 ) "*"           "*"             "*"            " "          
## 24  ( 1 ) "*"           "*"             "*"            " "          
## 25  ( 1 ) "*"           "*"             "*"            " "          
## 26  ( 1 ) "*"           "*"             "*"            " "          
## 27  ( 1 ) "*"           "*"             "*"            " "          
## 28  ( 1 ) "*"           "*"             "*"            " "          
## 29  ( 1 ) "*"           "*"             "*"            " "          
## 30  ( 1 ) "*"           " "             "*"            "*"          
## 31  ( 1 ) "*"           " "             "*"            "*"          
## 32  ( 1 ) "*"           "*"             "*"            "*"          
## 33  ( 1 ) "*"           "*"             "*"            "*"          
## 34  ( 1 ) "*"           "*"             "*"            "*"          
## 35  ( 1 ) "*"           "*"             "*"            "*"          
## 36  ( 1 ) "*"           "*"             "*"            "*"          
## 37  ( 1 ) "*"           "*"             "*"            "*"          
##           Monat_cJuli Monat_cJuni Monat_cMai Monat_cMärz Monat_cNovember
## 1  ( 1 )  " "         " "         " "        " "         " "            
## 2  ( 1 )  " "         " "         " "        " "         " "            
## 3  ( 1 )  " "         " "         " "        " "         " "            
## 4  ( 1 )  " "         " "         " "        " "         " "            
## 5  ( 1 )  " "         " "         " "        " "         " "            
## 6  ( 1 )  " "         " "         " "        " "         " "            
## 7  ( 1 )  " "         " "         " "        " "         " "            
## 8  ( 1 )  " "         " "         " "        " "         " "            
## 9  ( 1 )  " "         " "         " "        " "         " "            
## 10  ( 1 ) " "         " "         " "        " "         "*"            
## 11  ( 1 ) " "         " "         " "        " "         "*"            
## 12  ( 1 ) " "         " "         " "        " "         "*"            
## 13  ( 1 ) " "         " "         " "        " "         "*"            
## 14  ( 1 ) " "         " "         " "        " "         "*"            
## 15  ( 1 ) " "         " "         " "        " "         "*"            
## 16  ( 1 ) " "         " "         " "        " "         "*"            
## 17  ( 1 ) " "         " "         "*"        " "         "*"            
## 18  ( 1 ) " "         "*"         "*"        " "         "*"            
## 19  ( 1 ) " "         "*"         "*"        " "         "*"            
## 20  ( 1 ) " "         "*"         "*"        " "         "*"            
## 21  ( 1 ) "*"         "*"         "*"        " "         " "            
## 22  ( 1 ) "*"         "*"         "*"        " "         " "            
## 23  ( 1 ) "*"         "*"         "*"        " "         " "            
## 24  ( 1 ) "*"         "*"         "*"        " "         " "            
## 25  ( 1 ) "*"         "*"         "*"        " "         " "            
## 26  ( 1 ) "*"         "*"         "*"        " "         " "            
## 27  ( 1 ) "*"         "*"         "*"        " "         " "            
## 28  ( 1 ) "*"         "*"         "*"        " "         " "            
## 29  ( 1 ) "*"         "*"         "*"        " "         " "            
## 30  ( 1 ) "*"         "*"         "*"        "*"         "*"            
## 31  ( 1 ) "*"         "*"         "*"        "*"         "*"            
## 32  ( 1 ) "*"         "*"         "*"        "*"         "*"            
## 33  ( 1 ) "*"         "*"         "*"        "*"         "*"            
## 34  ( 1 ) "*"         "*"         "*"        "*"         "*"            
## 35  ( 1 ) "*"         "*"         "*"        "*"         "*"            
## 36  ( 1 ) "*"         "*"         "*"        "*"         "*"            
## 37  ( 1 ) "*"         "*"         "*"        "*"         "*"            
##           Monat_cOktober Monat_cSeptember SommerferienSH SommerferienNRW
## 1  ( 1 )  " "            " "              " "            " "            
## 2  ( 1 )  " "            " "              " "            " "            
## 3  ( 1 )  " "            " "              " "            " "            
## 4  ( 1 )  " "            " "              " "            " "            
## 5  ( 1 )  " "            " "              " "            " "            
## 6  ( 1 )  " "            " "              " "            " "            
## 7  ( 1 )  " "            " "              " "            " "            
## 8  ( 1 )  " "            " "              " "            " "            
## 9  ( 1 )  " "            " "              "*"            " "            
## 10  ( 1 ) " "            " "              "*"            " "            
## 11  ( 1 ) " "            " "              "*"            " "            
## 12  ( 1 ) " "            " "              "*"            " "            
## 13  ( 1 ) " "            " "              "*"            " "            
## 14  ( 1 ) " "            " "              "*"            " "            
## 15  ( 1 ) " "            " "              "*"            " "            
## 16  ( 1 ) " "            " "              "*"            " "            
## 17  ( 1 ) " "            " "              "*"            " "            
## 18  ( 1 ) " "            " "              "*"            " "            
## 19  ( 1 ) " "            " "              "*"            " "            
## 20  ( 1 ) "*"            " "              "*"            " "            
## 21  ( 1 ) "*"            "*"              "*"            " "            
## 22  ( 1 ) "*"            "*"              "*"            " "            
## 23  ( 1 ) "*"            "*"              "*"            " "            
## 24  ( 1 ) "*"            "*"              "*"            " "            
## 25  ( 1 ) "*"            "*"              "*"            " "            
## 26  ( 1 ) "*"            "*"              "*"            "*"            
## 27  ( 1 ) "*"            "*"              "*"            "*"            
## 28  ( 1 ) "*"            "*"              "*"            "*"            
## 29  ( 1 ) "*"            "*"              "*"            "*"            
## 30  ( 1 ) "*"            "*"              "*"            "*"            
## 31  ( 1 ) "*"            "*"              "*"            "*"            
## 32  ( 1 ) "*"            "*"              "*"            "*"            
## 33  ( 1 ) "*"            "*"              "*"            "*"            
## 34  ( 1 ) "*"            "*"              "*"            "*"            
## 35  ( 1 ) "*"            "*"              "*"            "*"            
## 36  ( 1 ) "*"            "*"              "*"            "*"            
## 37  ( 1 ) "*"            "*"              "*"            "*"            
##           SommerferienNDS SommerferienHE Feiertag Ostern
## 1  ( 1 )  " "             " "            " "      " "   
## 2  ( 1 )  " "             " "            " "      " "   
## 3  ( 1 )  " "             " "            "*"      " "   
## 4  ( 1 )  " "             " "            "*"      " "   
## 5  ( 1 )  " "             " "            "*"      "*"   
## 6  ( 1 )  " "             " "            "*"      "*"   
## 7  ( 1 )  " "             " "            "*"      "*"   
## 8  ( 1 )  " "             " "            "*"      "*"   
## 9  ( 1 )  " "             " "            "*"      "*"   
## 10  ( 1 ) " "             " "            "*"      "*"   
## 11  ( 1 ) " "             " "            "*"      "*"   
## 12  ( 1 ) " "             " "            "*"      "*"   
## 13  ( 1 ) " "             " "            "*"      "*"   
## 14  ( 1 ) " "             " "            "*"      "*"   
## 15  ( 1 ) " "             " "            "*"      "*"   
## 16  ( 1 ) " "             " "            "*"      "*"   
## 17  ( 1 ) " "             " "            "*"      "*"   
## 18  ( 1 ) " "             " "            "*"      "*"   
## 19  ( 1 ) " "             " "            "*"      "*"   
## 20  ( 1 ) " "             " "            "*"      "*"   
## 21  ( 1 ) " "             " "            "*"      "*"   
## 22  ( 1 ) " "             " "            "*"      "*"   
## 23  ( 1 ) " "             " "            "*"      "*"   
## 24  ( 1 ) "*"             " "            "*"      "*"   
## 25  ( 1 ) "*"             " "            "*"      "*"   
## 26  ( 1 ) "*"             " "            "*"      "*"   
## 27  ( 1 ) "*"             " "            "*"      "*"   
## 28  ( 1 ) "*"             " "            "*"      "*"   
## 29  ( 1 ) "*"             "*"            "*"      "*"   
## 30  ( 1 ) "*"             " "            "*"      "*"   
## 31  ( 1 ) "*"             "*"            "*"      "*"   
## 32  ( 1 ) "*"             "*"            "*"      "*"   
## 33  ( 1 ) "*"             "*"            "*"      "*"   
## 34  ( 1 ) "*"             "*"            "*"      "*"   
## 35  ( 1 ) "*"             "*"            "*"      "*"   
## 36  ( 1 ) "*"             "*"            "*"      "*"   
## 37  ( 1 ) "*"             "*"            "*"      "*"   
##           ChristiHimmelfahrt Pfingsten TDE Ostern_ext
## 1  ( 1 )  " "                " "       " " " "       
## 2  ( 1 )  " "                " "       " " " "       
## 3  ( 1 )  " "                " "       " " " "       
## 4  ( 1 )  " "                " "       " " " "       
## 5  ( 1 )  "*"                "*"       "*" " "       
## 6  ( 1 )  "*"                "*"       "*" " "       
## 7  ( 1 )  "*"                "*"       "*" " "       
## 8  ( 1 )  "*"                "*"       "*" " "       
## 9  ( 1 )  "*"                "*"       "*" " "       
## 10  ( 1 ) "*"                "*"       "*" " "       
## 11  ( 1 ) "*"                "*"       "*" " "       
## 12  ( 1 ) "*"                "*"       "*" "*"       
## 13  ( 1 ) "*"                "*"       "*" "*"       
## 14  ( 1 ) "*"                "*"       "*" "*"       
## 15  ( 1 ) "*"                "*"       "*" "*"       
## 16  ( 1 ) "*"                "*"       "*" "*"       
## 17  ( 1 ) "*"                "*"       "*" "*"       
## 18  ( 1 ) "*"                "*"       "*" "*"       
## 19  ( 1 ) "*"                "*"       "*" "*"       
## 20  ( 1 ) "*"                "*"       "*" "*"       
## 21  ( 1 ) "*"                "*"       "*" "*"       
## 22  ( 1 ) "*"                "*"       "*" "*"       
## 23  ( 1 ) "*"                "*"       "*" "*"       
## 24  ( 1 ) "*"                "*"       "*" "*"       
## 25  ( 1 ) "*"                "*"       "*" "*"       
## 26  ( 1 ) "*"                "*"       "*" "*"       
## 27  ( 1 ) "*"                "*"       "*" "*"       
## 28  ( 1 ) "*"                "*"       "*" "*"       
## 29  ( 1 ) "*"                "*"       "*" "*"       
## 30  ( 1 ) "*"                "*"       "*" "*"       
## 31  ( 1 ) "*"                "*"       "*" "*"       
## 32  ( 1 ) "*"                "*"       "*" "*"       
## 33  ( 1 ) "*"                "*"       "*" "*"       
## 34  ( 1 ) "*"                "*"       "*" "*"       
## 35  ( 1 ) "*"                "*"       "*" "*"       
## 36  ( 1 ) "*"                "*"       "*" "*"       
## 37  ( 1 ) "*"                "*"       "*" "*"       
##           ChristiHimmelfahrt_ext Pfingsten_ext Silvester_ext
## 1  ( 1 )  " "                    " "           "*"          
## 2  ( 1 )  " "                    " "           "*"          
## 3  ( 1 )  " "                    " "           "*"          
## 4  ( 1 )  " "                    " "           "*"          
## 5  ( 1 )  " "                    " "           " "          
## 6  ( 1 )  " "                    " "           " "          
## 7  ( 1 )  " "                    " "           " "          
## 8  ( 1 )  " "                    " "           " "          
## 9  ( 1 )  " "                    " "           " "          
## 10  ( 1 ) " "                    " "           " "          
## 11  ( 1 ) " "                    " "           "*"          
## 12  ( 1 ) " "                    " "           "*"          
## 13  ( 1 ) " "                    " "           "*"          
## 14  ( 1 ) " "                    " "           "*"          
## 15  ( 1 ) " "                    " "           "*"          
## 16  ( 1 ) " "                    " "           "*"          
## 17  ( 1 ) " "                    " "           "*"          
## 18  ( 1 ) " "                    " "           "*"          
## 19  ( 1 ) " "                    " "           "*"          
## 20  ( 1 ) " "                    " "           "*"          
## 21  ( 1 ) " "                    " "           "*"          
## 22  ( 1 ) " "                    " "           "*"          
## 23  ( 1 ) " "                    " "           "*"          
## 24  ( 1 ) " "                    " "           "*"          
## 25  ( 1 ) " "                    " "           "*"          
## 26  ( 1 ) " "                    " "           "*"          
## 27  ( 1 ) " "                    " "           "*"          
## 28  ( 1 ) " "                    " "           "*"          
## 29  ( 1 ) " "                    " "           "*"          
## 30  ( 1 ) " "                    " "           "*"          
## 31  ( 1 ) " "                    " "           "*"          
## 32  ( 1 ) " "                    " "           "*"          
## 33  ( 1 ) " "                    "*"           "*"          
## 34  ( 1 ) " "                    "*"           "*"          
## 35  ( 1 ) " "                    "*"           "*"          
## 36  ( 1 ) " "                    "*"           "*"          
## 37  ( 1 ) "*"                    "*"           "*"          
##           JahreszeitHerbst JahreszeitSommer JahreszeitWinter
## 1  ( 1 )  " "              " "              " "             
## 2  ( 1 )  " "              "*"              " "             
## 3  ( 1 )  " "              "*"              " "             
## 4  ( 1 )  " "              "*"              " "             
## 5  ( 1 )  " "              " "              " "             
## 6  ( 1 )  " "              "*"              " "             
## 7  ( 1 )  " "              "*"              " "             
## 8  ( 1 )  " "              "*"              " "             
## 9  ( 1 )  "*"              " "              " "             
## 10  ( 1 ) " "              " "              " "             
## 11  ( 1 ) " "              " "              " "             
## 12  ( 1 ) " "              " "              " "             
## 13  ( 1 ) " "              "*"              " "             
## 14  ( 1 ) " "              "*"              " "             
## 15  ( 1 ) " "              "*"              " "             
## 16  ( 1 ) " "              "*"              " "             
## 17  ( 1 ) " "              "*"              " "             
## 18  ( 1 ) " "              "*"              " "             
## 19  ( 1 ) " "              "*"              " "             
## 20  ( 1 ) " "              "*"              " "             
## 21  ( 1 ) "*"              " "              " "             
## 22  ( 1 ) "*"              " "              "*"             
## 23  ( 1 ) "*"              " "              "*"             
## 24  ( 1 ) "*"              " "              "*"             
## 25  ( 1 ) "*"              " "              "*"             
## 26  ( 1 ) "*"              " "              "*"             
## 27  ( 1 ) "*"              " "              "*"             
## 28  ( 1 ) "*"              " "              "*"             
## 29  ( 1 ) "*"              " "              "*"             
## 30  ( 1 ) "*"              " "              "*"             
## 31  ( 1 ) "*"              " "              "*"             
## 32  ( 1 ) "*"              " "              "*"             
## 33  ( 1 ) "*"              " "              "*"             
## 34  ( 1 ) "*"              "*"              "*"             
## 35  ( 1 ) "*"              " "              "*"             
## 36  ( 1 ) "*"              "*"              "*"             
## 37  ( 1 ) "*"              "*"              "*"

Für ein Modell mit einer Variablen kann beobachtet werden, dass die Variable Silvester_ext ein Sternchen hat, was signalisiert, dass ein Regressionsmodell mit Umsatz ~ Silvester_ext das beste Einzelvariablenmodell ist. Das beste 2-Variablen-Modell ist Umsatz ~ Silvester_ext + JahreszeitSommer. Das beste 3-Variablen-Modell ist Umsatz ~ Silvester_ext + JahreszeitSommer + Feiertag. Und so weiter.

Schrittweise Auswahl (“Stepwise selection”)

Schrittweise vorwärts (Forward stepwise)

Die schrittweise Vorwärtsauswahl kann mit regsubsets durchgeführt werden, indem die method = "forward" gesetzt wird:

Schrittweise rückwärts (Backward stepwise)

Die schrittweise Vorwärtsauswahl kann mit regsubsets durchgeführt werden, indem die method = "backward" gesetzt wird:

Modellauswahl

Indirekte Schätzung des Testfehlers mit \(C_{p}\), \(AIC\), \(BIC\) und adjustiertem \(R^2\)

## [1] 31
## [1] 22
## [1] 27

Es ist erkennbar, dass die Ergebnisse leicht unterschiedliche Modelle identifizieren, die als die besten angesehen werden. Die ajustierte \(R^2\)-Statistik legt nahe, dass ein 31-Variablen-Modell bevorzugt wird, die \(BIC\)-Statistik schlägt ein 22-Variablenmodell vor und der \(C_{p}\) ein 27-Variablen-Modell vor.

Wir vergleichen das Ergebnis mit denen der stepwise selection:

## [1] 27
## [1] 29

Wenn man das optimale \(C_{p}\) für vorwärts und rückwärts schrittweise bewertet, ist erkennbar, dass gemäß der Vorwärts-Methode ein 27-Variablen-Modell die \(C_{p}\)-Statistik minimiert. Die Rückwärtsmethode schlägt ein 29-Variablen-Modell vor.

Wenn wir die Modelle der subset selection vergleichen, ergibt sich bzgl. der Zusammensetzung der Prädikatoren folgendes Bild:.

##        (Intercept)         Temperatur Wochentag_cFreitag 
##         254.738374          -2.266673          16.123187 
## Wochentag_cSamstag Wochentag_cSonntag      Monat_cAugust 
##          50.660451          48.892227          66.493506 
##    Monat_cDezember     Monat_cFebruar        Monat_cJuli 
##         -21.024805          29.821237          48.148185 
##        Monat_cJuni         Monat_cMai     Monat_cOktober 
##          39.950741          28.252117          53.586614 
##   Monat_cSeptember     SommerferienSH           Feiertag 
##          54.678777          26.839961        1253.501439 
##             Ostern ChristiHimmelfahrt          Pfingsten 
##       -1371.682393       -1201.197389       -1208.451384 
##                TDE         Ostern_ext      Silvester_ext 
##       -1195.229972         153.788742         175.066611 
##   JahreszeitHerbst   JahreszeitWinter 
##         -41.102070         -14.890257
##        (Intercept)        KielerWoche         Bewoelkung 
##         268.032007          15.863106          -1.468629 
##         Temperatur Wochentag_cFreitag  Wochentag_cMontag 
##          -2.671124          13.717486         -10.726879 
## Wochentag_cSamstag Wochentag_cSonntag      Monat_cAugust 
##          48.062902          45.529362          59.156961 
##    Monat_cDezember     Monat_cFebruar        Monat_cJuli 
##         -20.380110          30.345489          30.847401 
##        Monat_cJuni         Monat_cMai     Monat_cOktober 
##          34.682821          29.614819          55.411584 
##   Monat_cSeptember     SommerferienSH    SommerferienNRW 
##          57.018065          20.959567          13.754971 
##    SommerferienNDS           Feiertag             Ostern 
##          17.734031        1255.352329       -1366.854091 
## ChristiHimmelfahrt          Pfingsten                TDE 
##       -1207.205006       -1203.650200       -1195.259264 
##         Ostern_ext      Silvester_ext   JahreszeitHerbst 
##         151.309360         174.404916         -40.936587 
##   JahreszeitWinter 
##         -15.714840
##         (Intercept)         KielerWoche          Bewoelkung 
##         255.6442683          16.4911414          -1.5661465 
##          Temperatur Windgeschwindigkeit  Wochentag_cFreitag 
##          -2.6350940           0.4225708          13.9311125 
##   Wochentag_cMontag  Wochentag_cSamstag  Wochentag_cSonntag 
##         -10.6928427          48.4432933          45.7160795 
##       Monat_cAugust      Monat_cFebruar       Monat_cJanuar 
##          64.2304244          49.9045166          19.6944957 
##         Monat_cJuli         Monat_cJuni          Monat_cMai 
##          37.3987138          42.3978429          36.6484061 
##         Monat_cMärz     Monat_cNovember      Monat_cOktober 
##          18.9266262          18.4775466          72.8677620 
##    Monat_cSeptember      SommerferienSH     SommerferienNRW 
##          67.5339084          19.0408018          13.3216502 
##     SommerferienNDS      SommerferienHE            Feiertag 
##          14.3478219           8.2354791        1253.9685005 
##              Ostern  ChristiHimmelfahrt           Pfingsten 
##       -1365.8199310       -1205.6473118       -1202.1935466 
##                 TDE          Ostern_ext       Silvester_ext 
##       -1195.4186280         153.0112693         174.2224552 
##    JahreszeitHerbst    JahreszeitWinter 
##         -50.4376536         -27.3221036

Betrachtet man die Variablenauswahl der stepwise selection genauer, ergibt sich folgendes Bild:

##        (Intercept)         Bewoelkung         Temperatur 
##         265.505078          -1.446825          -2.584725 
## Wochentag_cFreitag  Wochentag_cMontag Wochentag_cSamstag 
##          13.620128         -10.573699          48.620543 
## Wochentag_cSonntag      Monat_cAugust    Monat_cDezember 
##          46.038233          45.488650         -26.460117 
##     Monat_cFebruar        Monat_cJuli        Monat_cJuni 
##          29.651459          29.364119          37.989729 
##         Monat_cMai    Monat_cNovember     Monat_cOktober 
##          30.581955          -7.302670          47.030766 
##   Monat_cSeptember     SommerferienSH     SommerferienHE 
##          42.234937          23.729266          14.203924 
##           Feiertag             Ostern ChristiHimmelfahrt 
##        1255.017639       -1366.527389       -1206.677670 
##          Pfingsten                TDE         Ostern_ext 
##       -1204.176488       -1195.182448         152.692199 
##      Silvester_ext   JahreszeitHerbst   JahreszeitSommer 
##         179.798487         -31.350914          17.428428 
##   JahreszeitWinter 
##         -13.109788
##        (Intercept)        KielerWoche         Bewoelkung 
##         260.530989          15.819133          -1.522818 
##         Temperatur Wochentag_cFreitag  Wochentag_cMontag 
##          -2.601691          13.805732         -10.860807 
## Wochentag_cSamstag Wochentag_cSonntag      Monat_cAugust 
##          48.216251          45.499928          65.984160 
##     Monat_cFebruar      Monat_cJanuar        Monat_cJuli 
##          49.720382          19.352472          37.360180 
##        Monat_cJuni         Monat_cMai        Monat_cMärz 
##          41.137152          36.232873          18.901279 
##    Monat_cNovember     Monat_cOktober   Monat_cSeptember 
##          18.507187          72.910246          66.596185 
##     SommerferienSH    SommerferienNRW    SommerferienNDS 
##          20.353220          13.853114          17.700078 
##           Feiertag             Ostern ChristiHimmelfahrt 
##        1255.332792       -1369.130553       -1207.186049 
##          Pfingsten                TDE         Ostern_ext 
##       -1203.353303       -1195.431419         154.574417 
##      Silvester_ext   JahreszeitHerbst   JahreszeitWinter 
##         173.361597         -51.493638         -27.542531

Direkte Schätzung des Testfehlers

Nun wird der Fehler der Testdaten für das beste Modell jeder Modellgröße berechnet. Zuerst wird eine Modellmatrix aus den Testdaten erstellt. Die Funktion model.matrix wird in vielen Regressionspaketen zum Erstellen einer X-Matrix aus Daten verwendet.

Jetzt kann jede Modellgröße (d.h. 1 Variable, 2 Variablen,…, 20 Variablen) durchlaufen werden und die Koeffizienten für das beste Modell dieser Größe extrahiert werden. Diese Werte werden sodann in die entsprechenden Spalten der Testmodellmatrix multipliziert, um die Vorhersagen zu bilden. Dann werden die Test-MSE berechnet.

##           [,1]
##  [1,] 5972.861
##  [2,] 5227.094
##  [3,] 4819.721
##  [4,] 4646.655
##  [5,] 3686.944
##  [6,] 2932.984
##  [7,] 2786.784
##  [8,] 2621.067
##  [9,] 3287.711
## [10,] 3186.449
## [11,] 3146.983
## [12,] 3225.637
## [13,] 2898.322
## [14,] 2886.311
## [15,] 2853.389
## [16,] 2875.855
## [17,] 2882.090
## [18,] 2886.838
## [19,] 2910.222
## [20,] 2857.982
## [21,] 2725.497
## [22,] 2731.256
## [23,] 2751.364
## [24,] 2779.303
## [25,] 2784.116
## [26,] 2794.999
## [27,] 2769.351
## [28,] 2766.063
## [29,] 2757.304
## [30,] 2774.713
## [31,] 2766.101
## [32,] 2776.358
## [33,] 2774.969
## [34,] 2770.578
## [35,] 2772.174
## [36,] 2767.774
## [37,] 2769.099

Es ist erkennbar, dass das 8-Variablen-Modell, das durch den besten Teilmengenansatz erzeugt wird, den niedrigsten Test-MSE erzeugt. Auch ein 21-Variablen-Modell scheint vergleichweichsweise gut zu performen.

Wir können jetzt die beste Teilmengenauswahl für den gesamten Datensatz durchführen, um zum einen das 16-Variablen-Modell zu erhalten. Dieses Modell wird mit dem 10-und dem 28-Variablen-Modell verglichen.

Teilmengenauswahl für das 8-Variablen-Modell

##        (Intercept) Wochentag_cSamstag Wochentag_cSonntag 
##          234.54873           51.98672           44.09080 
##           Feiertag             Ostern ChristiHimmelfahrt 
##         1402.59210        -1363.16956        -1335.99749 
##          Pfingsten                TDE   JahreszeitSommer 
##        -1334.68456        -1344.65307           47.34359

Die 8 Variablen sind die folgenden:

  • Wochentag_cSamstag
  • Wochentag_cSonntag
  • Feiertag
  • Ostern
  • ChristiHimmelfahrt
  • Pfingsten
  • TDE
  • JahreszeitSommer

Die Variablen Wochentag_c, Monat_c und Jahreszeit müssen nun noch dummyfiziert werden (bei Einbeziehung aller Variablen erfolgt die Dummyfizierung automatisch im Rahmen der Regressionsanalyse): Für jeden Wochentag wird eine Variable mit Ausprägung 0/1 gebildet und danach die alte Variable Wochentag_c entfernt. Analog wird bei den beiden anderen Variablen vorgegangen.

# Dummyfizierung der Variablen im Trainigsdatensatz:
df_lm_train_WG5_8 <- df_lm_train_WG5 %>%
  mutate(Montag=as.integer(df_lm_train_WG5$Wochentag_c=="Montag")) %>%
  mutate(Dienstag=as.integer(df_lm_train_WG5$Wochentag_c=="Dienstag")) %>%
  mutate(Mittwoch=as.integer(df_lm_train_WG5$Wochentag_c=="Mittwoch")) %>%
  mutate(Donnerstag=as.integer(df_lm_train_WG5$Wochentag_c=="Donnerstag")) %>%
  mutate(Freitag=as.integer(df_lm_train_WG5$Wochentag_c=="Freitag")) %>%
  mutate(Samstag=as.integer(df_lm_train_WG5$Wochentag_c=="Samstag")) %>%
  mutate(Sonntag=as.integer(df_lm_train_WG5$Wochentag_c=="Sonntag")) %>%
  mutate(Januar=as.integer(df_lm_train_WG5$Monat_c=="Januar")) %>%
  mutate(Februar=as.integer(df_lm_train_WG5$Monat_c=="Februar")) %>%
  mutate(Maerz=as.integer(df_lm_train_WG5$Monat_c=="März")) %>%
  mutate(April=as.integer(df_lm_train_WG5$Monat_c=="April")) %>%
  mutate(Mai=as.integer(df_lm_train_WG5$Monat_c=="Mai")) %>%
  mutate(Juni=as.integer(df_lm_train_WG5$Monat_c=="Juni")) %>%
  mutate(Juli=as.integer(df_lm_train_WG5$Monat_c=="Juli")) %>%
  mutate(August=as.integer(df_lm_train_WG5$Monat_c=="August")) %>%
  mutate(September=as.integer(df_lm_train_WG5$Monat_c=="September")) %>%
  mutate(Oktober=as.integer(df_lm_train_WG5$Monat_c=="Oktober")) %>%
  mutate(November=as.integer(df_lm_train_WG5$Monat_c=="November")) %>%
  mutate(Dezember=as.integer(df_lm_train_WG5$Monat_c=="Dezember")) %>%
  mutate(Fruehling=as.integer(df_lm_train_WG5$Jahreszeit=="Fruehling")) %>%
  mutate(Sommer=as.integer(df_lm_train_WG5$Jahreszeit=="Sommer")) %>%
  mutate(Herbst=as.integer(df_lm_train_WG5$Jahreszeit=="Herbst")) %>%
  mutate(Winter=as.integer(df_lm_train_WG5$Jahreszeit=="Winter")) %>%
  dplyr::select(-Wochentag_c, -Monat_c, -Jahreszeit)

df_lm_test_WG5_8 <- df_lm_test_WG5 %>%
  mutate(Montag=as.integer(df_lm_test_WG5$Wochentag_c=="Montag")) %>%
  mutate(Dienstag=as.integer(df_lm_test_WG5$Wochentag_c=="Dienstag")) %>%
  mutate(Mittwoch=as.integer(df_lm_test_WG5$Wochentag_c=="Mittwoch")) %>%
  mutate(Donnerstag=as.integer(df_lm_test_WG5$Wochentag_c=="Donnerstag")) %>%
  mutate(Freitag=as.integer(df_lm_test_WG5$Wochentag_c=="Freitag")) %>%
  mutate(Samstag=as.integer(df_lm_test_WG5$Wochentag_c=="Samstag")) %>%
  mutate(Sonntag=as.integer(df_lm_test_WG5$Wochentag_c=="Sonntag")) %>%
  mutate(Januar=as.integer(df_lm_test_WG5$Monat_c=="Januar")) %>%
  mutate(Februar=as.integer(df_lm_test_WG5$Monat_c=="Februar")) %>%
  mutate(Maerz=as.integer(df_lm_test_WG5$Monat_c=="März")) %>%
  mutate(April=as.integer(df_lm_test_WG5$Monat_c=="April")) %>%
  mutate(Mai=as.integer(df_lm_test_WG5$Monat_c=="Mai")) %>%
  mutate(Juni=as.integer(df_lm_test_WG5$Monat_c=="Juni")) %>%
  mutate(Juli=as.integer(df_lm_test_WG5$Monat_c=="Juli")) %>%
  mutate(August=as.integer(df_lm_test_WG5$Monat_c=="August")) %>%
  mutate(September=as.integer(df_lm_test_WG5$Monat_c=="September")) %>%
  mutate(Oktober=as.integer(df_lm_test_WG5$Monat_c=="Oktober")) %>%
  mutate(November=as.integer(df_lm_test_WG5$Monat_c=="November")) %>%
  mutate(Dezember=as.integer(df_lm_test_WG5$Monat_c=="Dezember")) %>%
  mutate(Fruehling=as.integer(df_lm_test_WG5$Jahreszeit=="Fruehling")) %>%
  mutate(Sommer=as.integer(df_lm_test_WG5$Jahreszeit=="Sommer")) %>%
  mutate(Herbst=as.integer(df_lm_test_WG5$Jahreszeit=="Herbst")) %>%
  mutate(Winter=as.integer(df_lm_test_WG5$Jahreszeit=="Winter")) %>%
  dplyr::select(-Wochentag_c, -Monat_c, -Jahreszeit)

Für das 8-Variablenmodell wird nun ein Regressionsmodell erstellt:

## # A tibble: 1 x 11
##   r.squared adj.r.squared sigma statistic   p.value    df logLik    AIC
##       <dbl>         <dbl> <dbl>     <dbl>     <dbl> <int>  <dbl>  <dbl>
## 1     0.726         0.724  49.9      348. 2.83e-289     9 -5649. 11318.
## # ... with 3 more variables: BIC <dbl>, deviance <dbl>, df.residual <int>

Dann wird (die Modellgüte) anhand der Test-Stichprobe getestet:

Als Ergebnis wird ein Vektor erzeugt, der für jede Beobachtung des Test-Samples den geschätzten (vorhergesagten) Umsatzwert speichert. Die Gütewerte lassen sich mit caret::postResample ausgeben:

##       RMSE   Rsquared        MAE 
## 51.1963561  0.7246812 38.9197760

Diese Vorhersage-Ergebnisse werden den Test-Daten hinzugefügt, sodann die Gütekennzahlen berechnet, die wiederum der gemeinsamen Übersichtstabelle für die Gütekennzahlen lm_vgl_kennz hinzugefügt werden:

# Hinzufügen der Ergebnisse
df_lm_test_WG5_8 <- df_lm_test_WG5_8 %>%
  mutate(predicted = lm_WG5_8_predict)

# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
df_lm_test_WG5_8 <-df_lm_test_WG5_8 %>%
  mutate(Prognose_zuhoch = (predicted >= Umsatz)) %>%
  mutate(Abweichung = predicted - Umsatz) %>%
  mutate(Abweichung_abs = abs(predicted - Umsatz)) %>%
  mutate(Abweichung_rel = (predicted - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Ergänze die benötigten Hilfsgrößen
df_lm_test_WG5_8 <- df_lm_test_WG5_8 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- df_lm_test_WG5_8 %>%
  group_by() %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz), 2), Umsatz_mittel = round(sum(Umsatz)/n(), 2), MAE = round(mean(Abweichung_abs), 2), MPE = round(mean(Abweichung_rel)*100, 2), MAPE = round(mean(Abweichung_rel_abs)*100, 2), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100, 2), MSE = round(mean(Abweichung_quad), 2), RMSE = round(sqrt(mean(Abweichung_quad)), 2), rRMSE = round(RMSE/Umsatz_mittel*100, 2))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "best8_bss_WG5")

# füge die Kennzahlen nun an die Vergleichstabelle
lm_vgl_kennz <- rbind(lm_vgl_kennz, temp)
lm_vgl_kennz
## # A tibble: 16 x 11
##    Anzahl Umsatz_ges Umsatz_mittel   MAE   MPE  MAPE  WAPE   MSE  RMSE
##     <int>      <dbl>         <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
##  1    346     45738.         132.   24.8 -7.84  18.7  18.8 1067.  32.7
##  2    346     45738.         132.   24.8 -7.65  18.8  18.8 1064.  32.6
##  3    346     45738.         132.   24.7 -7.93  18.5  18.7 1050.  32.4
##  4    346     45738.         132.   24.7 -7.91  18.6  18.7 1050.  32.4
##  5    346    130413.         377.   39.8  3.37  11.4  10.6 2708.  52.0
##  6    346    130413.         377.   39.8  3.45  11.4  10.6 2722.  52.2
##  7    346    130413.         377.   40.3  3.48  11.6  10.7 2768.  52.6
##  8    346    130413.         377.   39.9  3.52  11.5  10.6 2720.  52.2
##  9    346     59316.         171.   31.2 -8.4   17.3  18.2 1751.  41.8
## 10    346     59316.         171.   30.9 -8.38  17.4  18.0 1722.  41.5
## 11    345     28354.          82.2  17.7 13.7   24.5  21.5  526.  22.9
## 12    345     28354.          82.2  18.3 12.0   24.2  22.2  607.  24.6
## 13    345     28354.          82.2  18.1 11.6   23.8  22.1  593.  24.4
## 14    345     28354.          82.2  18.2 11.5   23.9  22.2  599.  24.5
## 15    345     28354.          82.2  18.4 12.1   24.2  22.3  604.  24.6
## 16    346     93912.         271.   38.9  0.87  14.6  14.3 2621.  51.2
## # ... with 2 more variables: rRMSE <dbl>, Modell <chr>

Teilmengenauswahl für das 22-Variablen-Modell gemäß best subset selection

Die 22 Variablen sind die folgenden:

  • Temperatur
  • Wochentag_cFreitag
  • Wochentag_cSamstag
  • Wochentag_cSonntag
  • Monat_cAugust
  • Monat_cDezember
  • Monat_cFebruar
  • Monat_cJuli
  • Monat_cJuni
  • Monat_cMai
  • Monat_cOktober
  • Monat_cSeptember
  • SommerferienSH
  • Feiertag
  • Ostern
  • ChristiHimmelfahrt
  • Pfingsten
  • TDE
  • Ostern_ext
  • Silvester_ext
  • JahreszeitHerbst
  • JahreszeitWinter

Die Variablen Wochentag_c, Monat_c und Jahreszeit müssen nun noch dummyfiziert werden (bei Einbeziehung aller Variablen erfolgt die Dummyfizierung automatisch im Rahmen der Regressionsanalyse): Für jeden Wochentag wird eine Variable mit Ausprägung 0/1 gebildet und danach die alte Variable Wochentag_c entfernt. Analog wird bei den beiden anderen Variablen vorgegangen.

# Dummyfizierung der Variablen im Trainigsdatensatz:
df_lm_train_WG5_22 <- df_lm_train_WG5 %>%
  mutate(Montag=as.integer(df_lm_train_WG5$Wochentag_c=="Montag")) %>%
  mutate(Dienstag=as.integer(df_lm_train_WG5$Wochentag_c=="Dienstag")) %>%
  mutate(Mittwoch=as.integer(df_lm_train_WG5$Wochentag_c=="Mittwoch")) %>%
  mutate(Donnerstag=as.integer(df_lm_train_WG5$Wochentag_c=="Donnerstag")) %>%
  mutate(Freitag=as.integer(df_lm_train_WG5$Wochentag_c=="Freitag")) %>%
  mutate(Samstag=as.integer(df_lm_train_WG5$Wochentag_c=="Samstag")) %>%
  mutate(Sonntag=as.integer(df_lm_train_WG5$Wochentag_c=="Sonntag")) %>%
  mutate(Januar=as.integer(df_lm_train_WG5$Monat_c=="Januar")) %>%
  mutate(Februar=as.integer(df_lm_train_WG5$Monat_c=="Februar")) %>%
  mutate(Maerz=as.integer(df_lm_train_WG5$Monat_c=="März")) %>%
  mutate(April=as.integer(df_lm_train_WG5$Monat_c=="April")) %>%
  mutate(Mai=as.integer(df_lm_train_WG5$Monat_c=="Mai")) %>%
  mutate(Juni=as.integer(df_lm_train_WG5$Monat_c=="Juni")) %>%
  mutate(Juli=as.integer(df_lm_train_WG5$Monat_c=="Juli")) %>%
  mutate(August=as.integer(df_lm_train_WG5$Monat_c=="August")) %>%
  mutate(September=as.integer(df_lm_train_WG5$Monat_c=="September")) %>%
  mutate(Oktober=as.integer(df_lm_train_WG5$Monat_c=="Oktober")) %>%
  mutate(November=as.integer(df_lm_train_WG5$Monat_c=="November")) %>%
  mutate(Dezember=as.integer(df_lm_train_WG5$Monat_c=="Dezember")) %>%
  mutate(Fruehling=as.integer(df_lm_train_WG5$Jahreszeit=="Fruehling")) %>%
  mutate(Sommer=as.integer(df_lm_train_WG5$Jahreszeit=="Sommer")) %>%
  mutate(Herbst=as.integer(df_lm_train_WG5$Jahreszeit=="Herbst")) %>%
  mutate(Winter=as.integer(df_lm_train_WG5$Jahreszeit=="Winter")) %>%
  dplyr::select(-Wochentag_c, -Monat_c, -Jahreszeit)

df_lm_test_WG5_22 <- df_lm_test_WG5 %>%
  mutate(Montag=as.integer(df_lm_test_WG5$Wochentag_c=="Montag")) %>%
  mutate(Dienstag=as.integer(df_lm_test_WG5$Wochentag_c=="Dienstag")) %>%
  mutate(Mittwoch=as.integer(df_lm_test_WG5$Wochentag_c=="Mittwoch")) %>%
  mutate(Donnerstag=as.integer(df_lm_test_WG5$Wochentag_c=="Donnerstag")) %>%
  mutate(Freitag=as.integer(df_lm_test_WG5$Wochentag_c=="Freitag")) %>%
  mutate(Samstag=as.integer(df_lm_test_WG5$Wochentag_c=="Samstag")) %>%
  mutate(Sonntag=as.integer(df_lm_test_WG5$Wochentag_c=="Sonntag")) %>%
  mutate(Januar=as.integer(df_lm_test_WG5$Monat_c=="Januar")) %>%
  mutate(Februar=as.integer(df_lm_test_WG5$Monat_c=="Februar")) %>%
  mutate(Maerz=as.integer(df_lm_test_WG5$Monat_c=="März")) %>%
  mutate(April=as.integer(df_lm_test_WG5$Monat_c=="April")) %>%
  mutate(Mai=as.integer(df_lm_test_WG5$Monat_c=="Mai")) %>%
  mutate(Juni=as.integer(df_lm_test_WG5$Monat_c=="Juni")) %>%
  mutate(Juli=as.integer(df_lm_test_WG5$Monat_c=="Juli")) %>%
  mutate(August=as.integer(df_lm_test_WG5$Monat_c=="August")) %>%
  mutate(September=as.integer(df_lm_test_WG5$Monat_c=="September")) %>%
  mutate(Oktober=as.integer(df_lm_test_WG5$Monat_c=="Oktober")) %>%
  mutate(November=as.integer(df_lm_test_WG5$Monat_c=="November")) %>%
  mutate(Dezember=as.integer(df_lm_test_WG5$Monat_c=="Dezember")) %>%
  mutate(Fruehling=as.integer(df_lm_test_WG5$Jahreszeit=="Fruehling")) %>%
  mutate(Sommer=as.integer(df_lm_test_WG5$Jahreszeit=="Sommer")) %>%
  mutate(Herbst=as.integer(df_lm_test_WG5$Jahreszeit=="Herbst")) %>%
  mutate(Winter=as.integer(df_lm_test_WG5$Jahreszeit=="Winter")) %>%
  dplyr::select(-Wochentag_c, -Monat_c, -Jahreszeit)

Für das 22-Variablenmodell wird nun ein Regressionsmodell erstellt:

## # A tibble: 1 x 11
##   r.squared adj.r.squared sigma statistic p.value    df logLik    AIC
##       <dbl>         <dbl> <dbl>     <dbl>   <dbl> <int>  <dbl>  <dbl>
## 1     0.803         0.799  42.5      193.       0    23 -5473. 10994.
## # ... with 3 more variables: BIC <dbl>, deviance <dbl>, df.residual <int>

Dann wird (die Modellgüte) anhand der Test-Stichprobe getestet:

Als Ergebnis wird ein Vektor erzeugt, der für jede Beobachtung des Test-Samples den geschätzten (vorhergesagten) Umsatzwert speichert. Die Gütewerte lassen sich mit caret::postResample ausgeben:

##       RMSE   Rsquared        MAE 
## 51.8482483  0.7188751 38.9361476

Diese Vorhersage-Ergebnisse werden den Test-Daten hinzugefügt, sodann die Gütekennzahlen berechnet, die wiederum der gemeinsamen Übersichtstabelle für die Gütekennzahlen lm_vgl_kennz hinzugefügt werden:

# Hinzufügen der Ergebnisse
df_lm_test_WG5_22 <- df_lm_test_WG5_22 %>%
  mutate(predicted = lm_WG5_22_predict)

# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
df_lm_test_WG5_22 <-df_lm_test_WG5_22 %>%
  mutate(Prognose_zuhoch = (predicted >= Umsatz)) %>%
  mutate(Abweichung = predicted - Umsatz) %>%
  mutate(Abweichung_abs = abs(predicted - Umsatz)) %>%
  mutate(Abweichung_rel = (predicted - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Ergänze die benötigten Hilfsgrößen
df_lm_test_WG5_22 <- df_lm_test_WG5_22 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- df_lm_test_WG5_22 %>%
  group_by() %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz), 2), Umsatz_mittel = round(sum(Umsatz)/n(), 2), MAE = round(mean(Abweichung_abs), 2), MPE = round(mean(Abweichung_rel)*100, 2), MAPE = round(mean(Abweichung_rel_abs)*100, 2), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100, 2), MSE = round(mean(Abweichung_quad), 2), RMSE = round(sqrt(mean(Abweichung_quad)), 2), rRMSE = round(RMSE/Umsatz_mittel*100, 2))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "best22_bss_WG5")

# füge die Kennzahlen nun an die Vergleichstabelle
lm_vgl_kennz <- rbind(lm_vgl_kennz, temp)
lm_vgl_kennz
## # A tibble: 17 x 11
##    Anzahl Umsatz_ges Umsatz_mittel   MAE   MPE  MAPE  WAPE   MSE  RMSE
##     <int>      <dbl>         <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
##  1    346     45738.         132.   24.8 -7.84  18.7  18.8 1067.  32.7
##  2    346     45738.         132.   24.8 -7.65  18.8  18.8 1064.  32.6
##  3    346     45738.         132.   24.7 -7.93  18.5  18.7 1050.  32.4
##  4    346     45738.         132.   24.7 -7.91  18.6  18.7 1050.  32.4
##  5    346    130413.         377.   39.8  3.37  11.4  10.6 2708.  52.0
##  6    346    130413.         377.   39.8  3.45  11.4  10.6 2722.  52.2
##  7    346    130413.         377.   40.3  3.48  11.6  10.7 2768.  52.6
##  8    346    130413.         377.   39.9  3.52  11.5  10.6 2720.  52.2
##  9    346     59316.         171.   31.2 -8.4   17.3  18.2 1751.  41.8
## 10    346     59316.         171.   30.9 -8.38  17.4  18.0 1722.  41.5
## 11    345     28354.          82.2  17.7 13.7   24.5  21.5  526.  22.9
## 12    345     28354.          82.2  18.3 12.0   24.2  22.2  607.  24.6
## 13    345     28354.          82.2  18.1 11.6   23.8  22.1  593.  24.4
## 14    345     28354.          82.2  18.2 11.5   23.9  22.2  599.  24.5
## 15    345     28354.          82.2  18.4 12.1   24.2  22.3  604.  24.6
## 16    346     93912.         271.   38.9  0.87  14.6  14.3 2621.  51.2
## 17    346     93912.         271.   38.9 -0.05  14.5  14.4 2688.  51.8
## # ... with 2 more variables: rRMSE <dbl>, Modell <chr>

Teilmengenauswahl für das 27-Variablen-Modell gemäß best subset selection

Die 27 Variablen sind die folgenden:

  • KielerWoche
  • Bewoelkung
  • Temperatur
  • Wochentag_cFreitag
  • Wochentag_cMontag
  • Wochentag_cSamstag
  • Wochentag_cSonntag
  • Monat_cAugust
  • Monat_cDezember
  • Monat_cFebruar
  • Monat_cJuli
  • Monat_cJuni
  • Monat_cMai
  • Monat_cOktober
  • Monat_cSeptember
  • SommerferienSH
  • SommerferienNRW
  • SommerferienNDS
  • Feiertag
  • Ostern
  • ChristiHimmelfahrt
  • Pfingsten
  • TDE
  • Ostern_ext
  • Silvester_ext
  • JahreszeitHerbst
  • JahreszeitWinter

Die Variablen Wochentag_c, Monat_c und Jahreszeit müssen nun noch dummyfiziert werden (bei Einbeziehung aller Variablen erfolgt die Dummyfizierung automatisch im Rahmen der Regressionsanalyse): Für jeden Wochentag wird eine Variable mit Ausprägung 0/1 gebildet und danach die alte Variable Wochentag_c entfernt. Analog wird bei den beiden anderen Variablen vorgegangen.

# Dummyfizierung der Variablen im Trainigsdatensatz:
df_lm_train_WG5_27 <- df_lm_train_WG5 %>%
  mutate(Montag=as.integer(df_lm_train_WG5$Wochentag_c=="Montag")) %>%
  mutate(Dienstag=as.integer(df_lm_train_WG5$Wochentag_c=="Dienstag")) %>%
  mutate(Mittwoch=as.integer(df_lm_train_WG5$Wochentag_c=="Mittwoch")) %>%
  mutate(Donnerstag=as.integer(df_lm_train_WG5$Wochentag_c=="Donnerstag")) %>%
  mutate(Freitag=as.integer(df_lm_train_WG5$Wochentag_c=="Freitag")) %>%
  mutate(Samstag=as.integer(df_lm_train_WG5$Wochentag_c=="Samstag")) %>%
  mutate(Sonntag=as.integer(df_lm_train_WG5$Wochentag_c=="Sonntag")) %>%
  mutate(Januar=as.integer(df_lm_train_WG5$Monat_c=="Januar")) %>%
  mutate(Februar=as.integer(df_lm_train_WG5$Monat_c=="Februar")) %>%
  mutate(Maerz=as.integer(df_lm_train_WG5$Monat_c=="März")) %>%
  mutate(April=as.integer(df_lm_train_WG5$Monat_c=="April")) %>%
  mutate(Mai=as.integer(df_lm_train_WG5$Monat_c=="Mai")) %>%
  mutate(Juni=as.integer(df_lm_train_WG5$Monat_c=="Juni")) %>%
  mutate(Juli=as.integer(df_lm_train_WG5$Monat_c=="Juli")) %>%
  mutate(August=as.integer(df_lm_train_WG5$Monat_c=="August")) %>%
  mutate(September=as.integer(df_lm_train_WG5$Monat_c=="September")) %>%
  mutate(Oktober=as.integer(df_lm_train_WG5$Monat_c=="Oktober")) %>%
  mutate(November=as.integer(df_lm_train_WG5$Monat_c=="November")) %>%
  mutate(Dezember=as.integer(df_lm_train_WG5$Monat_c=="Dezember")) %>%
  mutate(Fruehling=as.integer(df_lm_train_WG5$Jahreszeit=="Fruehling")) %>%
  mutate(Sommer=as.integer(df_lm_train_WG5$Jahreszeit=="Sommer")) %>%
  mutate(Herbst=as.integer(df_lm_train_WG5$Jahreszeit=="Herbst")) %>%
  mutate(Winter=as.integer(df_lm_train_WG5$Jahreszeit=="Winter")) %>%
  dplyr::select(-Wochentag_c, -Monat_c, -Jahreszeit)

df_lm_test_WG5_27 <- df_lm_test_WG5 %>%
  mutate(Montag=as.integer(df_lm_test_WG5$Wochentag_c=="Montag")) %>%
  mutate(Dienstag=as.integer(df_lm_test_WG5$Wochentag_c=="Dienstag")) %>%
  mutate(Mittwoch=as.integer(df_lm_test_WG5$Wochentag_c=="Mittwoch")) %>%
  mutate(Donnerstag=as.integer(df_lm_test_WG5$Wochentag_c=="Donnerstag")) %>%
  mutate(Freitag=as.integer(df_lm_test_WG5$Wochentag_c=="Freitag")) %>%
  mutate(Samstag=as.integer(df_lm_test_WG5$Wochentag_c=="Samstag")) %>%
  mutate(Sonntag=as.integer(df_lm_test_WG5$Wochentag_c=="Sonntag")) %>%
  mutate(Januar=as.integer(df_lm_test_WG5$Monat_c=="Januar")) %>%
  mutate(Februar=as.integer(df_lm_test_WG5$Monat_c=="Februar")) %>%
  mutate(Maerz=as.integer(df_lm_test_WG5$Monat_c=="März")) %>%
  mutate(April=as.integer(df_lm_test_WG5$Monat_c=="April")) %>%
  mutate(Mai=as.integer(df_lm_test_WG5$Monat_c=="Mai")) %>%
  mutate(Juni=as.integer(df_lm_test_WG5$Monat_c=="Juni")) %>%
  mutate(Juli=as.integer(df_lm_test_WG5$Monat_c=="Juli")) %>%
  mutate(August=as.integer(df_lm_test_WG5$Monat_c=="August")) %>%
  mutate(September=as.integer(df_lm_test_WG5$Monat_c=="September")) %>%
  mutate(Oktober=as.integer(df_lm_test_WG5$Monat_c=="Oktober")) %>%
  mutate(November=as.integer(df_lm_test_WG5$Monat_c=="November")) %>%
  mutate(Dezember=as.integer(df_lm_test_WG5$Monat_c=="Dezember")) %>%
  mutate(Fruehling=as.integer(df_lm_test_WG5$Jahreszeit=="Fruehling")) %>%
  mutate(Sommer=as.integer(df_lm_test_WG5$Jahreszeit=="Sommer")) %>%
  mutate(Herbst=as.integer(df_lm_test_WG5$Jahreszeit=="Herbst")) %>%
  mutate(Winter=as.integer(df_lm_test_WG5$Jahreszeit=="Winter")) %>%
  dplyr::select(-Wochentag_c, -Monat_c, -Jahreszeit)

Für das 27-Variablenmodell wird nun ein Regressionsmodell erstellt:

## # A tibble: 1 x 11
##   r.squared adj.r.squared sigma statistic p.value    df logLik    AIC
##       <dbl>         <dbl> <dbl>     <dbl>   <dbl> <int>  <dbl>  <dbl>
## 1     0.808         0.803  42.1      161.       0    28 -5459. 10977.
## # ... with 3 more variables: BIC <dbl>, deviance <dbl>, df.residual <int>

Dann wird (die Modellgüte) anhand der Test-Stichprobe getestet:

Als Ergebnis wird ein Vektor erzeugt, der für jede Beobachtung des Test-Samples den geschätzten (vorhergesagten) Umsatzwert speichert. Die Gütewerte lassen sich mit caret::postResample ausgeben:

##       RMSE   Rsquared        MAE 
## 52.6246269  0.7097689 39.2765909

Diese Vorhersage-Ergebnisse werden den Test-Daten hinzugefügt, sodann die Gütekennzahlen berechnet, die wiederum der gemeinsamen Übersichtstabelle für die Gütekennzahlen lm_vgl_kennz hinzugefügt werden:

# Hinzufügen der Ergebnisse
df_lm_test_WG5_27 <- df_lm_test_WG5_27 %>%
  mutate(predicted = lm_WG5_27_predict)

# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
df_lm_test_WG5_27 <-df_lm_test_WG5_27 %>%
  mutate(Prognose_zuhoch = (predicted >= Umsatz)) %>%
  mutate(Abweichung = predicted - Umsatz) %>%
  mutate(Abweichung_abs = abs(predicted - Umsatz)) %>%
  mutate(Abweichung_rel = (predicted - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Ergänze die benötigten Hilfsgrößen
df_lm_test_WG5_27 <- df_lm_test_WG5_27 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- df_lm_test_WG5_27 %>%
  group_by() %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz), 2), Umsatz_mittel = round(sum(Umsatz)/n(), 2), MAE = round(mean(Abweichung_abs), 2), MPE = round(mean(Abweichung_rel)*100, 2), MAPE = round(mean(Abweichung_rel_abs)*100, 2), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100, 2), MSE = round(mean(Abweichung_quad), 2), RMSE = round(sqrt(mean(Abweichung_quad)), 2), rRMSE = round(RMSE/Umsatz_mittel*100, 2))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "best27_bss_WG5")

# füge die Kennzahlen nun an die Vergleichstabelle
lm_vgl_kennz <- rbind(lm_vgl_kennz, temp)
lm_vgl_kennz
## # A tibble: 18 x 11
##    Anzahl Umsatz_ges Umsatz_mittel   MAE   MPE  MAPE  WAPE   MSE  RMSE
##     <int>      <dbl>         <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
##  1    346     45738.         132.   24.8 -7.84  18.7  18.8 1067.  32.7
##  2    346     45738.         132.   24.8 -7.65  18.8  18.8 1064.  32.6
##  3    346     45738.         132.   24.7 -7.93  18.5  18.7 1050.  32.4
##  4    346     45738.         132.   24.7 -7.91  18.6  18.7 1050.  32.4
##  5    346    130413.         377.   39.8  3.37  11.4  10.6 2708.  52.0
##  6    346    130413.         377.   39.8  3.45  11.4  10.6 2722.  52.2
##  7    346    130413.         377.   40.3  3.48  11.6  10.7 2768.  52.6
##  8    346    130413.         377.   39.9  3.52  11.5  10.6 2720.  52.2
##  9    346     59316.         171.   31.2 -8.4   17.3  18.2 1751.  41.8
## 10    346     59316.         171.   30.9 -8.38  17.4  18.0 1722.  41.5
## 11    345     28354.          82.2  17.7 13.7   24.5  21.5  526.  22.9
## 12    345     28354.          82.2  18.3 12.0   24.2  22.2  607.  24.6
## 13    345     28354.          82.2  18.1 11.6   23.8  22.1  593.  24.4
## 14    345     28354.          82.2  18.2 11.5   23.9  22.2  599.  24.5
## 15    345     28354.          82.2  18.4 12.1   24.2  22.3  604.  24.6
## 16    346     93912.         271.   38.9  0.87  14.6  14.3 2621.  51.2
## 17    346     93912.         271.   38.9 -0.05  14.5  14.4 2688.  51.8
## 18    346     93912.         271.   39.3  0.1   14.6  14.5 2769.  52.6
## # ... with 2 more variables: rRMSE <dbl>, Modell <chr>

Teilmengenauswahl für das 27-Variablen-Modell gemäß forward selection

Für das 27-Variablenmodell gemäß forward selection wird nun ein Regressionsmodell erstellt:

## # A tibble: 1 x 11
##   r.squared adj.r.squared sigma statistic p.value    df logLik    AIC
##       <dbl>         <dbl> <dbl>     <dbl>   <dbl> <int>  <dbl>  <dbl>
## 1     0.808         0.803  42.2      161.       0    28 -5461. 10980.
## # ... with 3 more variables: BIC <dbl>, deviance <dbl>, df.residual <int>

Dann wird (die Modellgüte) anhand der Test-Stichprobe getestet:

Als Ergebnis wird ein Vektor erzeugt, der für jede Beobachtung des Test-Samples den geschätzten (vorhergesagten) Umsatzwert speichert. Die Gütewerte lassen sich mit caret::postResample ausgeben:

##       RMSE   Rsquared        MAE 
## 52.4067514  0.7119959 39.3203782

Diese Vorhersage-Ergebnisse werden den Test-Daten hinzugefügt, sodann die Gütekennzahlen berechnet, die wiederum der gemeinsamen Übersichtstabelle für die Gütekennzahlen lm_vgl_kennz hinzugefügt werden:

# Hinzufügen der Ergebnisse
df_lm_test_WG5_27 <- df_lm_test_WG5_27 %>%
  mutate(predicted = lm_WG5_27_predict_for)

# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
df_lm_test_WG5_27 <-df_lm_test_WG5_27 %>%
  mutate(Prognose_zuhoch = (predicted >= Umsatz)) %>%
  mutate(Abweichung = predicted - Umsatz) %>%
  mutate(Abweichung_abs = abs(predicted - Umsatz)) %>%
  mutate(Abweichung_rel = (predicted - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Ergänze die benötigten Hilfsgrößen
df_lm_test_WG5_27 <- df_lm_test_WG5_27 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- df_lm_test_WG5_27 %>%
  group_by() %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz), 2), Umsatz_mittel = round(sum(Umsatz)/n(), 2), MAE = round(mean(Abweichung_abs), 2), MPE = round(mean(Abweichung_rel)*100, 2), MAPE = round(mean(Abweichung_rel_abs)*100, 2), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100, 2), MSE = round(mean(Abweichung_quad), 2), RMSE = round(sqrt(mean(Abweichung_quad)), 2), rRMSE = round(RMSE/Umsatz_mittel*100, 2))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "best27_forward_WG5")

# füge die Kennzahlen nun an die Vergleichstabelle
lm_vgl_kennz <- rbind(lm_vgl_kennz, temp)
lm_vgl_kennz
## # A tibble: 19 x 11
##    Anzahl Umsatz_ges Umsatz_mittel   MAE   MPE  MAPE  WAPE   MSE  RMSE
##     <int>      <dbl>         <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
##  1    346     45738.         132.   24.8 -7.84  18.7  18.8 1067.  32.7
##  2    346     45738.         132.   24.8 -7.65  18.8  18.8 1064.  32.6
##  3    346     45738.         132.   24.7 -7.93  18.5  18.7 1050.  32.4
##  4    346     45738.         132.   24.7 -7.91  18.6  18.7 1050.  32.4
##  5    346    130413.         377.   39.8  3.37  11.4  10.6 2708.  52.0
##  6    346    130413.         377.   39.8  3.45  11.4  10.6 2722.  52.2
##  7    346    130413.         377.   40.3  3.48  11.6  10.7 2768.  52.6
##  8    346    130413.         377.   39.9  3.52  11.5  10.6 2720.  52.2
##  9    346     59316.         171.   31.2 -8.4   17.3  18.2 1751.  41.8
## 10    346     59316.         171.   30.9 -8.38  17.4  18.0 1722.  41.5
## 11    345     28354.          82.2  17.7 13.7   24.5  21.5  526.  22.9
## 12    345     28354.          82.2  18.3 12.0   24.2  22.2  607.  24.6
## 13    345     28354.          82.2  18.1 11.6   23.8  22.1  593.  24.4
## 14    345     28354.          82.2  18.2 11.5   23.9  22.2  599.  24.5
## 15    345     28354.          82.2  18.4 12.1   24.2  22.3  604.  24.6
## 16    346     93912.         271.   38.9  0.87  14.6  14.3 2621.  51.2
## 17    346     93912.         271.   38.9 -0.05  14.5  14.4 2688.  51.8
## 18    346     93912.         271.   39.3  0.1   14.6  14.5 2769.  52.6
## 19    346     93912.         271.   39.3  0.13  14.6  14.5 2746.  52.4
## # ... with 2 more variables: rRMSE <dbl>, Modell <chr>

Teilmengenauswahl für das 29-Variablen-Modell gemäß backward selection

Die 29 Variablen sind die folgenden:

  • KielerWoche
  • Bewoelkung
  • Temperatur
  • Wochentag_cFreitag
  • Wochentag_cMontag
  • Wochentag_cSamstag
  • Wochentag_cSonntag
  • Monat_cAugust
  • Monat_cFebruar
  • Monat_cJanuar
  • Monat_cJuli
  • Monat_cJuni
  • Monat_cMai
  • Monat_cMärz
  • Monat_cNovember
  • Monat_cOktober
  • Monat_cSeptember
  • SommerferienSH
  • SommerferienNRW
  • SommerferienNDS
  • Feiertag
  • Ostern
  • ChristiHimmelfahrt
  • Pfingsten
  • TDE
  • Ostern_ext
  • Silvester_ext
  • JahreszeitHerbst
  • JahreszeitWinter

Die Variablen Wochentag_c, Monat_c und Jahreszeit müssen nun noch dummyfiziert werden (bei Einbeziehung aller Variablen erfolgt die Dummyfizierung automatisch im Rahmen der Regressionsanalyse): Für jeden Wochentag wird eine Variable mit Ausprägung 0/1 gebildet und danach die alte Variable Wochentag_c entfernt. Analog wird bei den beiden anderen Variablen vorgegangen.

# Dummyfizierung der Variablen im Trainigsdatensatz:
df_lm_train_WG5_29 <- df_lm_train_WG5 %>%
  mutate(Montag=as.integer(df_lm_train_WG5$Wochentag_c=="Montag")) %>%
  mutate(Dienstag=as.integer(df_lm_train_WG5$Wochentag_c=="Dienstag")) %>%
  mutate(Mittwoch=as.integer(df_lm_train_WG5$Wochentag_c=="Mittwoch")) %>%
  mutate(Donnerstag=as.integer(df_lm_train_WG5$Wochentag_c=="Donnerstag")) %>%
  mutate(Freitag=as.integer(df_lm_train_WG5$Wochentag_c=="Freitag")) %>%
  mutate(Samstag=as.integer(df_lm_train_WG5$Wochentag_c=="Samstag")) %>%
  mutate(Sonntag=as.integer(df_lm_train_WG5$Wochentag_c=="Sonntag")) %>%
  mutate(Januar=as.integer(df_lm_train_WG5$Monat_c=="Januar")) %>%
  mutate(Februar=as.integer(df_lm_train_WG5$Monat_c=="Februar")) %>%
  mutate(Maerz=as.integer(df_lm_train_WG5$Monat_c=="März")) %>%
  mutate(April=as.integer(df_lm_train_WG5$Monat_c=="April")) %>%
  mutate(Mai=as.integer(df_lm_train_WG5$Monat_c=="Mai")) %>%
  mutate(Juni=as.integer(df_lm_train_WG5$Monat_c=="Juni")) %>%
  mutate(Juli=as.integer(df_lm_train_WG5$Monat_c=="Juli")) %>%
  mutate(August=as.integer(df_lm_train_WG5$Monat_c=="August")) %>%
  mutate(September=as.integer(df_lm_train_WG5$Monat_c=="September")) %>%
  mutate(Oktober=as.integer(df_lm_train_WG5$Monat_c=="Oktober")) %>%
  mutate(November=as.integer(df_lm_train_WG5$Monat_c=="November")) %>%
  mutate(Dezember=as.integer(df_lm_train_WG5$Monat_c=="Dezember")) %>%
  mutate(Fruehling=as.integer(df_lm_train_WG5$Jahreszeit=="Fruehling")) %>%
  mutate(Sommer=as.integer(df_lm_train_WG5$Jahreszeit=="Sommer")) %>%
  mutate(Herbst=as.integer(df_lm_train_WG5$Jahreszeit=="Herbst")) %>%
  mutate(Winter=as.integer(df_lm_train_WG5$Jahreszeit=="Winter")) %>%
  dplyr::select(-Wochentag_c, -Monat_c, -Jahreszeit)

df_lm_test_WG5_29 <- df_lm_test_WG5 %>%
  mutate(Montag=as.integer(df_lm_test_WG5$Wochentag_c=="Montag")) %>%
  mutate(Dienstag=as.integer(df_lm_test_WG5$Wochentag_c=="Dienstag")) %>%
  mutate(Mittwoch=as.integer(df_lm_test_WG5$Wochentag_c=="Mittwoch")) %>%
  mutate(Donnerstag=as.integer(df_lm_test_WG5$Wochentag_c=="Donnerstag")) %>%
  mutate(Freitag=as.integer(df_lm_test_WG5$Wochentag_c=="Freitag")) %>%
  mutate(Samstag=as.integer(df_lm_test_WG5$Wochentag_c=="Samstag")) %>%
  mutate(Sonntag=as.integer(df_lm_test_WG5$Wochentag_c=="Sonntag")) %>%
  mutate(Januar=as.integer(df_lm_test_WG5$Monat_c=="Januar")) %>%
  mutate(Februar=as.integer(df_lm_test_WG5$Monat_c=="Februar")) %>%
  mutate(Maerz=as.integer(df_lm_test_WG5$Monat_c=="März")) %>%
  mutate(April=as.integer(df_lm_test_WG5$Monat_c=="April")) %>%
  mutate(Mai=as.integer(df_lm_test_WG5$Monat_c=="Mai")) %>%
  mutate(Juni=as.integer(df_lm_test_WG5$Monat_c=="Juni")) %>%
  mutate(Juli=as.integer(df_lm_test_WG5$Monat_c=="Juli")) %>%
  mutate(August=as.integer(df_lm_test_WG5$Monat_c=="August")) %>%
  mutate(September=as.integer(df_lm_test_WG5$Monat_c=="September")) %>%
  mutate(Oktober=as.integer(df_lm_test_WG5$Monat_c=="Oktober")) %>%
  mutate(November=as.integer(df_lm_test_WG5$Monat_c=="November")) %>%
  mutate(Dezember=as.integer(df_lm_test_WG5$Monat_c=="Dezember")) %>%
  mutate(Fruehling=as.integer(df_lm_test_WG5$Jahreszeit=="Fruehling")) %>%
  mutate(Sommer=as.integer(df_lm_test_WG5$Jahreszeit=="Sommer")) %>%
  mutate(Herbst=as.integer(df_lm_test_WG5$Jahreszeit=="Herbst")) %>%
  mutate(Winter=as.integer(df_lm_test_WG5$Jahreszeit=="Winter")) %>%
  dplyr::select(-Wochentag_c, -Monat_c, -Jahreszeit)

Für das 29-Variablenmodell gemäß backward selection wird nun ein Regressionsmodell erstellt:

## # A tibble: 1 x 11
##   r.squared adj.r.squared sigma statistic p.value    df logLik    AIC
##       <dbl>         <dbl> <dbl>     <dbl>   <dbl> <int>  <dbl>  <dbl>
## 1     0.809         0.803  42.1      150.       0    30 -5458. 10978.
## # ... with 3 more variables: BIC <dbl>, deviance <dbl>, df.residual <int>

Dann wird (die Modellgüte) anhand der Test-Stichprobe getestet:

Als Ergebnis wird ein Vektor erzeugt, der für jede Beobachtung des Test-Samples den geschätzten (vorhergesagten) Umsatzwert speichert. Die Gütewerte lassen sich mit caret::postResample ausgeben:

##       RMSE   Rsquared        MAE 
## 52.7229373  0.7088223 39.1048137

Diese Vorhersage-Ergebnisse werden den Test-Daten hinzugefügt, sodann die Gütekennzahlen berechnet, die wiederum der gemeinsamen Übersichtstabelle für die Gütekennzahlen lm_vgl_kennz hinzugefügt werden:

# Hinzufügen der Ergebnisse
df_lm_test_WG5_29 <- df_lm_test_WG5_29 %>%
  mutate(predicted = lm_WG5_29_predict)

# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
df_lm_test_WG5_29 <-df_lm_test_WG5_29 %>%
  mutate(Prognose_zuhoch = (predicted >= Umsatz)) %>%
  mutate(Abweichung = predicted - Umsatz) %>%
  mutate(Abweichung_abs = abs(predicted - Umsatz)) %>%
  mutate(Abweichung_rel = (predicted - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Ergänze die benötigten Hilfsgrößen
df_lm_test_WG5_29 <- df_lm_test_WG5_29 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- df_lm_test_WG5_29 %>%
  group_by() %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz), 2), Umsatz_mittel = round(sum(Umsatz)/n(), 2), MAE = round(mean(Abweichung_abs), 2), MPE = round(mean(Abweichung_rel)*100, 2), MAPE = round(mean(Abweichung_rel_abs)*100, 2), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100, 2), MSE = round(mean(Abweichung_quad), 2), RMSE = round(sqrt(mean(Abweichung_quad)), 2), rRMSE = round(RMSE/Umsatz_mittel*100, 2))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "best29_backward_WG5")

# füge die Kennzahlen nun an die Vergleichstabelle
lm_vgl_kennz <- rbind(lm_vgl_kennz, temp)
lm_vgl_kennz
## # A tibble: 20 x 11
##    Anzahl Umsatz_ges Umsatz_mittel   MAE   MPE  MAPE  WAPE   MSE  RMSE
##     <int>      <dbl>         <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
##  1    346     45738.         132.   24.8 -7.84  18.7  18.8 1067.  32.7
##  2    346     45738.         132.   24.8 -7.65  18.8  18.8 1064.  32.6
##  3    346     45738.         132.   24.7 -7.93  18.5  18.7 1050.  32.4
##  4    346     45738.         132.   24.7 -7.91  18.6  18.7 1050.  32.4
##  5    346    130413.         377.   39.8  3.37  11.4  10.6 2708.  52.0
##  6    346    130413.         377.   39.8  3.45  11.4  10.6 2722.  52.2
##  7    346    130413.         377.   40.3  3.48  11.6  10.7 2768.  52.6
##  8    346    130413.         377.   39.9  3.52  11.5  10.6 2720.  52.2
##  9    346     59316.         171.   31.2 -8.4   17.3  18.2 1751.  41.8
## 10    346     59316.         171.   30.9 -8.38  17.4  18.0 1722.  41.5
## 11    345     28354.          82.2  17.7 13.7   24.5  21.5  526.  22.9
## 12    345     28354.          82.2  18.3 12.0   24.2  22.2  607.  24.6
## 13    345     28354.          82.2  18.1 11.6   23.8  22.1  593.  24.4
## 14    345     28354.          82.2  18.2 11.5   23.9  22.2  599.  24.5
## 15    345     28354.          82.2  18.4 12.1   24.2  22.3  604.  24.6
## 16    346     93912.         271.   38.9  0.87  14.6  14.3 2621.  51.2
## 17    346     93912.         271.   38.9 -0.05  14.5  14.4 2688.  51.8
## 18    346     93912.         271.   39.3  0.1   14.6  14.5 2769.  52.6
## 19    346     93912.         271.   39.3  0.13  14.6  14.5 2746.  52.4
## 20    346     93912.         271.   39.1  0.08  14.5  14.4 2780.  52.7
## # ... with 2 more variables: rRMSE <dbl>, Modell <chr>

Auch für Warengruppe 5 ergibt sich ein ähnliches Bild wie für alle anderen Warengruppen: Die Modelle weichen nur marginal voneinander ab. Je nachdem, ob man den MPE oder den RMSE als finales Entscheidungskriteirum heranzieht, performt im ersten Fall das 22-Variablen-Modell am besten, im letzteren das 8-Variablen-Modell.

6.4 Vergleich der linearen Modelle

Wir haben jetzt die Gütekennzahlen für sämtliche Warengruppen für verschiedene Modelle ermittelt. Innerhalb der Warengruppen unterscheiden sich die Modelle nur marginal. Die besten Modelle für die Warengruppen sind:

  • Warengruppe 1: 21 Variablen
  • Warengruppe 2: 24 Variablen
  • Warengruppe 3: 30 Variablen
  • Warengruppe 4: 1 Variablen
  • Warengruppe 5: 8 Variablen.

In Anlehnung an gängiges Vorgehen in der Praxis wurde jeweils das einfachste Modell gewählt, also das mit möglichst wenig Variablen.

Dann fällt auf, dass die Schätzer für die Warengruppe 1 und 3 offenbar systematisch zu niedrig sind, weil die mittlere relative Abweichung bei -8% liegt. Warengruppe 4 wird dagegen konsequent zu hoch geschätzt. Für die Warengruppen 2 und 5 liegt der Wert näher an Null bzw. ist gleich 0.

Und der mittlere gewichtete Absolutwert der relativen Abweichung (WAPE), den wir vorrangig als Güte-Kriterium im Auge haben, zeigt den niedrigsten Wert für Warengruppe 2, gefolgt von Warengruppe 5. Ähnliche Ergebnisse hatten wir auch mit dem besten naiven Modell erzielt: Dort konnten mit dem erweiterten gleitenden Durchschnitt der letzten 4 Wochen- bzw. Wochenendtage die besten Ergebnisse für die Warengruppen insgesamt erzielt werden und für die Warengruppe 2 lag der WAPE ebenfalls bei 11.

Wir widmen uns nun den Verfahren aus dem Bereich Machine Learning und Deep Learning und wollen rausfinden, ob sich damit noch bessere Ergebnisse erzielen lassen.

7 Anwendung von ML Verfahren: Decision Trees (Entscheidungsbäume)

7.1 Vorhaben

In einem weiteren Schritt wird mit den Entscheidungsbäumen ein erstes Machine Learning-Verfahren angewendet.

Entscheidungsbäume stellen, allgemein gesprochen, Entscheidungen und deren Konsequenzen in einer baumähnlichen Struktur dar. Dabei stellen die Prüfungen die “Astgabeln” oder “Knoten” (nodes) dar, die “Äste” die Entscheidungen der Prüfungen und die “Blätter” des Baumes repräsentieren die Entscheidung des Modells. Entscheidungsbäume können sowohl für Klassifikations- als auch für numerische Vorhersagemodelle verwendet werden.

Grundlegende Entscheidungsbäume unterteilen einen Datensatz in kleinere Gruppen und passen dann für jede Untergruppe ein einfaches Modell (Konstante) an. Leider ist ein einzelnes Baummodell in der Regel sehr instabil und ein schlechter Prädiktor. Durch Bootstrap-Aggregation (Bagging) von Entscheidungsbäumen kann diese Technik jedoch sehr leistungsfähig und effektiv werden. Darüber hinaus bildet dies die grundlegende Grundlage für komplexere baumbasierte Modelle wie Random Forests (“zufällige Wälder”) und sog. gradient boosting machines (“Maschinen zur Erhöhung des Gradienten”).

In diesem Projekt werden nur Entscheidungsbäume und Tuning behandelt.

Die Idee

Es gibt viele Methoden zur Konstruktion von Entscheidungsbäumen, aber eine der ältesten ist der von Breiman et al. entwickelte Klassifizierungs- und Regressionsbaumansatz (CART). (1984). Dieses Projekt konzentriert sich auf den Regressionsteil von CART. Grundlegende Entscheidungs- bzw. Regressionsbäume unterteilen einen Datensatz in kleinere Untergruppen und passen dann für jede Beobachtung in der Untergruppe eine einfache Konstante an. Die Partitionierung wird durch aufeinanderfolgende binäre Partitionen (auch als rekursive Partitionierung bezeichnet) auf der Grundlage der verschiedenen Prädiktoren erreicht. Die vorherzusagende Konstante basiert auf den durchschnittlichen Antwortwerten für alle Beobachtungen, die in diese Untergruppe fallen.

Nehmen wir zum Beispiel an, wir möchten die Umsatz pro Tag einer Bäckereifiliale basierend auf Wochentagen, Jahreszeit, Ferien, … vorhersagen. Alle Beobachtungen gehen durch diesen Baum, werden an einem bestimmten Knoten bewertet und gehen nach links, wenn die Antwort “Ja” lautet, oder nach rechts, wenn die Antwort “Nein” lautet. Alle Beobachtungen mit Samstag oder Sonntag gehen also zum linken Zweig, alle anderen Beobachtungen zum rechten Zweig. Als nächstes wird der linke Zweig weiter nach der Jahreszeit aufgeteilt. Diese Samstag- oder Sonntag-Beobachtungen mit der Jahreszeit Sommer gehen zum linken Zweig über, diejenigen mit Frühling, Herbst oder Winter gehen nach rechts. Und so weiter. Diese Zweige führen abschließend zu Endknoten oder Blättern, die unseren vorhergesagten Umsatz pro Tag enthalten.

Über Splits entscheiden

Erstens ist es wichtig zu erkennen, dass die Partitionierung von Variablen von oben nach unten erfolgt. Dies bedeutet, dass sich eine früher in der Baumstruktur ausgeführte Partition nicht aufgrund späterer Partitionen ändert.

Aber wie werden diese Partitionen hergestellt? Das Modell beginnt mit dem gesamten Datensatz \(S\) und durchsucht jeden einzelnen Wert jeder Eingabevariablen, um den Prädiktor und den Teilungswert zu finden, der die Daten in zwei Regionen unterteilt (\(R_1\) und \(R_2\)) derart, dass die Gesamtsummen der Fehlerquadrate minimiert werden:

\[minimiere(SSE = \sum_{i \epsilon R_1}(y_i-c_1)^2+\sum_{i \epsilon R_2}(y_i-c_2)^2 \tag{1}\]

Nachdem wir die beste Aufteilung gefunden haben, teilen wir die Daten in die beiden resultierenden Regionen auf und wiederholen den Aufteilungsprozess für jede der beiden Regionen. Dieser Vorgang wird fortgesetzt, bis ein Stoppkriterium erreicht ist. Das Ergebnis ist in der Regel ein sehr tiefer, komplexer Baum, der zwar gute Vorhersagen für den Trainingssatz liefert, die Daten jedoch wahrscheinlich überpasst, was zu einer schlechten Leistung bei unsichtbaren Daten führt.

Durch Beschneiden dieser Entscheidungsknoten auf niedrigerer Ebene können wir ein wenig Verzerrung in unser Modell einbringen, die zur Stabilisierung von Vorhersagen beiträgt und dazu neigt, besser auf neue, unsichtbare Daten zu verallgemeinern.

Kostenkomplexitätskriterium

In der Tiefe und Komplexität des Baums muss häufig ein Gleichgewicht erreicht werden, um die Vorhersageleistung für einige unsichtbare Daten zu optimieren. Um dieses Gleichgewicht zu finden, bilden wir normalerweise einen sehr großen Baum, wie im vorherigen Abschnitt definiert, und beschneiden ihn dann, um einen optimalen Teilbaum zu finden. Wir finden den optimalen Teilbaum unter Verwendung eines Kostenkomplexitätsparameters (\(\alpha\)), der unsere Zielfunktion (s. (1)) für die Anzahl der Endknoten des Baumes (\(T\)) “bestraft”:

\[minimiere(SSE+\alpha{|T|}) \tag{2}\]

Für einen gegebenen Wert von \(\alpha\) finden wir den kleinsten beschnittenen Baum mit dem niedrigsten bestraften Fehler. Dabei führen kleinere Strafen tendenziell zu komplexeren Modellen, was zu größeren Bäumen führt, während größere Strafen zu viel kleineren Bäumen führen. Wenn ein Baum größer wird, muss folglich die Verringerung der \(SSE\) größer sein als die Kostenkomplexitätsstrafe. Typischerweise bewerten wir mehrere Modelle über ein Spektrum von \(\alpha\) und verwenden die Kreuzvalidierung, um das optimale \(\alpha\) und damit den optimalen Teilbaum zu identifizieren

Laden notwendiger packages

Für das Vorhaben werden die nachfolgenden packages benötigt und somit geladen. Die meisten dieser packages/Pakete spielen eine unterstützende Rolle, während der Schwerpunkt auf dem rpart-package liegt.

## Warning: package 'rpart' was built under R version 3.6.3
## Warning: package 'rpart.plot' was built under R version 3.6.3

7.2 Datenaufbereitung

Wir arbeiten mit dem vollständigen Datensatz df_voll. Dieser enthält im Zeitraum 01.07.2013 bis 31.07.2019 eine Zeile für jedes Datum und jede Warengruppe. In den Rohdaten fehlende Umsätze sind auf Basis der Vorwochenwerte ergänzt worden. Die Zeilen mit ergänzten Umsätzen sind selektierbar über die Variable Umsatz_NA (= TRUE).

Für unser Vorhaben beschränken wir uns auf die in den Rohdaten vorhandenen Umsätze (Umsatz_NA = FALSE). Und wir schränken die Trainingsdaten später auf den Zeitraum 2015 bis 2017 ein, weil wir oben gesehen hatten, dass die Umsätze in 2014 systematisch höher liegen als in den folgenden Jahren. Die Umsätze des Jahres 2018 dienen uns dann als Testdaten.

Wir erstellen für diesen Abschnitt einen Analysedatensatz df_dt auf Basis von df_voll. Redundante Spalten nehmen wir raus (Wochentag, Monat, Jahreszeit) und entfernen die nicht benötigten Umsatz-Spalten (Umsatz_NA sowie die Umsatz_lag Variablen).

Weiterhin werden fehlende Werte eleminiert.

Für die Trainingsdaten verwenden wir den Zeitraum 2015 bis 2017 und für die Testdaten das Jahr 2018. Die Modellierung erfolgt je Warengruppe, daher teilen wir den Datensatz df_dt auf.

7.3 Grundlegende Implementierung und Tuning

Wir können einen Regressionsbaum mit rpart anpassen und ihn dann mit rpart.plot visualisieren. Der Anpassungsprozess und die visuelle Ausgabe von Regressionsbäumen und Klassifizierungsbäumen sind sehr ähnlich. Beide verwenden die Formelmethode zum Ausdrücken des Modells (ähnlich wie lm). Wenn wir jedoch einen Regressionsbaum anpassen, müssen wir method = "anova" setzen. Standardmäßig errät rpart auf intelligente Weise, welche Methode anzuwenden ist. Es wird jedoch empfohlen, die Methode aus Gründen der Reproduzierbarkeit explizit festzulegen, was wir hier auch tun.

Grundlegende Implementierung - Warengruppe 1

Wir beginnen mit Warengruppe 1:

## n= 1061 
## 
## node), split, n, deviance, yval
##       * denotes terminal node
## 
##   1) root 1061 1563625.00 115.84770  
##     2) Wochentag_c=Sonntag 152   83154.48  70.13539 *
##     3) Wochentag_c=Dienstag,Donnerstag,Freitag,Mittwoch,Montag,Samstag 909 1109737.00 123.49150  
##       6) Monat_c=Dezember,Februar,Januar,Mai,März,November 449  411981.10 112.89780  
##        12) Wochentag_c=Dienstag,Mittwoch 153   87761.02 102.87250 *
##        13) Wochentag_c=Donnerstag,Freitag,Montag,Samstag 296  300894.50 118.07970  
##          26) Monat_c=Februar,Januar,November 147   78542.65 111.16610 *
##          27) Monat_c=Dezember,Mai,März 149  208393.70 124.90050  
##            54) Herbst>=0.5 34   15459.65 106.30530 *
##            55) Herbst< 0.5 115  177701.60 130.39820  
##             110) Monat_c=Mai,März 100   90925.75 123.84400 *
##             111) Monat_c=Dezember 15   53842.03 174.09270 *
##       7) Monat_c=April,August,Juli,Juni,Oktober,September 460  598180.50 133.83200  
##        14) Wochentag_c=Dienstag,Freitag,Mittwoch,Montag 303  238193.20 125.72070  
##          28) SommerferienSH< 0.5 232  165626.30 120.53570  
##            56) Wochentag_c=Dienstag,Mittwoch 116   49095.09 111.53700 *
##            57) Wochentag_c=Freitag,Montag 116   97744.38 129.53450 *
##          29) SommerferienSH>=0.5 71   45950.02 142.66300 *
##        15) Wochentag_c=Donnerstag,Samstag 157  301577.80 149.48630  
##          30) Windgeschwindigkeit< 17.5 148  170217.30 145.88320  
##            60) SommerferienSH< 0.5 112  103566.60 138.44150 *
##            61) SommerferienSH>=0.5 36   41152.06 169.03500 *
##          31) Windgeschwindigkeit>=17.5 9   97842.50 208.73780 *

Sobald wir unser Modell angepasst haben, können wir einen Blick auf den dt1_WG1-Output werfen. Dieser erklärt die Schritte der Teilung: Wir beginnen bspw. mit 1061 Beobachtungen am Wurzelknoten (ganz am Anfang) und die erste Variable, die zur Teilung verwendet wird (also die erste Variable, die eine Reduzierung der SSE optimiert), ist der Wochentag Sonntag. Wir sehen, dass am ersten Knoten alle Beobachtungen mit Wochentag_c = Sonntag zum zweiten Zweig gehen. Die Gesamtzahl der Beobachtungen, die diesem Zweig folgen (152), der durchschnittliche Umsatz (70,14) und der SSE (83154.48) sind aufgeführt.

Wenn man nach dem 3. Zweig sucht, sieht man, dass 909 Beobachtungen mit Wochentag_c = Dienstag, Donnerstag, Freitag, Mittwoch, Montag, Samstag diesem Zweig folgen und ihre durchschnittlichen Umsätze 123.49€ betragen und der SSE hier 1109737.00 beträgt.

Grundsätzlich sagt uns dies, dass die wichtigste Variable, die anfangs den größten Rückgang der SEE aufweist, der Wochentag ist, wobei die Umsätze sonntags in der Warengruppe Brot um > 40% geringer sind als an den anderen Tagen der Woche.

Wir können unser Modell mit rpart.plot visualisieren. rpart.plot bietet viele Plotoptionen, auf die wir an dieser Stelle nicht weiter eingehen werden. Im Standard-Plot werden jedoch der Prozentsatz der Daten angezeigt, die auf diesen Knoten fallen, und der durchschnittliche Umsatz für diesen Zweig.

## Warning: package 'partykit' was built under R version 3.6.3
## Loading required package: grid
## Loading required package: libcoin
## Warning: package 'libcoin' was built under R version 3.6.3
## Loading required package: mvtnorm

Man kann feststellen, dass dieser Baum 11 interne Knoten enthält, was zu 12 Endknoten führt. Grundsätzlich partitioniert dieser Baum in 11 Variablen, um sein Modell zu erstellen. Es gibt jedoch 28 Variablen in df_dt_train_WG1. Also was ist passiert?

Hinter den Kulissen wendet rpart automatisch einen Bereich von Kostenkomplexität an (α-Werte zum Beschneiden des Baums). Um den Fehler für jeden α-Wert zu vergleichen, führt rpart eine 10-fache Kreuzvalidierung durch, sodass der mit einem bestimmten α-Wert verbundene Fehler berechnet wird.

In diesem Beispiel finden wir abnehmende Renditen nach 12 Endknoten, wie in der Grafik dargestellt (y-Achse ist Kreuzvalidierungsfehler, untere x-Achse ist Kostenkomplexitätswert (α), obere x-Achse ist die Anzahl von Endknoten (Baumgröße = | T |)). Die gestrichelte Linie, die zwischen den Punkten | T | = 3 und 4 verläuft, deutet darauf hin, dass auch ein kleiner Baum gewählt werden kann. Breiman et al. (1984) schlugen vor, dass es in der Praxis üblich ist, den kleinsten Baum innerhalb von 1 Standardabweichung des minimalen Kreuzvalidierungsfehlers zu verwenden (auch bekannt als 1-SE-Regel). Daher könnten wir auch einen Baum mit 3 oder 4 Endknoten verwenden und vernünftigerweise erwarten, dass innerhalb einer kleinen Fehlergrenze ähnliche Ergebnisse erzielt werden.

##            CP nsplit rel error    xerror       xstd
## 1  0.23709823      0 1.0000000 1.0033892 0.08077320
## 2  0.06368273      1 0.7629018 0.7653761 0.07384845
## 3  0.03735521      2 0.6992190 0.7462149 0.07784048
## 4  0.02143612      3 0.6618638 0.7648511 0.07731125
## 5  0.01702257      4 0.6404277 0.7556469 0.07758900
## 6  0.01630738      5 0.6234051 0.7561685 0.07772089
## 7  0.01491763      6 0.6070978 0.7492144 0.07772372
## 8  0.01324367      7 0.5921801 0.7435754 0.07753293
## 9  0.01201489     10 0.5524491 0.7307760 0.07567048
## 10 0.01000000     11 0.5404342 0.7148807 0.07505475

Tuning - Warengruppe 1

Neben dem Kostenkomplexität (\(\alpha\))-Parameter ist es auch üblich folgende Parameter anzupassen:

  • minsplit: Die Mindestanzahl von Datenpunkten, die erforderlich sind, um eine Teilung zu versuchen, bevor ein Endknoten erstellt werden muss. Der Standardwert ist 20. Wenn man diesen Wert verkleinert, können Endknoten, die möglicherweise nur eine Handvoll Beobachtungen enthalten, erstellt werden um den vorhergesagten Wert zu prognostizieren.
  • maxdepth: Die maximale Anzahl interner Knoten zwischen dem Wurzelknoten und den Endknoten. Der Standardwert ist 30, was ziemlich liberal ist und das Bauen ziemlich großer Bäume ermöglicht.

rpart verwendet ein spezielles Steuer- bzw. Kontrollargument, bei dem eine Liste von Hyperparameterwerten bereitgestellt wird. Wenn wir beispielsweise ein Modell mit minsplit = 20 und maxdepth = 12 bewerten möchten, können wir Folgendes ausführen:

##            CP nsplit rel error    xerror       xstd
## 1  0.23709823      0 1.0000000 1.0032577 0.08085825
## 2  0.06368273      1 0.7629018 0.7669602 0.07406832
## 3  0.03735521      2 0.6992190 0.7476955 0.07374579
## 4  0.02143612      3 0.6618638 0.7093996 0.06931572
## 5  0.01702257      4 0.6404277 0.7044080 0.07122341
## 6  0.01630738      5 0.6234051 0.6992072 0.07147986
## 7  0.01491763      6 0.6070978 0.6932844 0.07092681
## 8  0.01324367      7 0.5921801 0.6847095 0.07058294
## 9  0.01201489     10 0.5524491 0.6852974 0.07084387
## 10 0.01000000     11 0.5404342 0.6709594 0.06885107

Obwohl dieser Ansatz nützlich ist, müssen mehrere Modelle manuell bewertet werden. Besser ist es insofern eine Rastersuche durchzuführen, um automatisch nach einer Reihe unterschiedlich abgestimmter Modelle zu suchen, um die optimale Hyperparametereinstellung zu ermitteln.

Um eine Rastersuche durchzuführen, erstellen wir zuerst unser Hyperparameter-Raster. In diesem Beispiel suchen wir einen Bereich von minsplit von 5 bis 150 und variiere die maximale Tiefe von 8 bis 15 (da unser ursprüngliches Modell eine optimale Tiefe von 12 gefunden hat). Das Ergebnis sind 1168 verschiedene Kombinationen, für die 1168 verschiedene Modelle erforderlich sind.

##   minsplit maxdepth
## 1        5        8
## 2        6        8
## 3        7        8
## 4        8        8
## 5        9        8
## 6       10        8
## [1] 1168

Um die Modellierung zu automatisieren, richten wir einfach eine for-Schleife ein und durchlaufen jede Kombination aus minsplit und maxdepth. Wir speichern jedes Modell in einem eigenen Listenelement.

Wir können jetzt eine Funktion erstellen, um den minimalen Fehler zu extrahieren, der mit dem α-Wert der optimalen Kostenkomplexität für jedes Modell verbunden ist.

##   minsplit maxdepth   cp     error
## 1       46       15 0.01 0.6076547
## 2       85        8 0.01 0.6098834
## 3       70       13 0.01 0.6100928
## 4      106       12 0.01 0.6112105
## 5      143       15 0.01 0.6113695

Es ist erkennbar, dass das optimale Modell eine leichte Verbesserung gegenüber unserem früheren Modell darstellt (xerror von 0.599 gegenüber 0.643).

Wenn die Ergebnisse zufriedenstellend sind, kann dieses endgültige optimale Modell angewendet werden und auf dem Testsatz vorhersagen.

## [1] 39.77669

Der endgültige RMSE beträgt 39.78, was darauf hindeutet, dass unsere prognostizierten Umsätze im Durchschnitt etwa 39.78 € vom tatsächlichen Umsatz abweichen.

Um das Modell abschließend mit den anderen vergleichen zu können, wird eine Tabelle mit den zu untersuchenden Kennzahlen erstellt:

## # A tibble: 1 x 11
##   Anzahl Umsatz_ges Umsatz_mittel   MAE   MPE  MAPE  WAPE   MSE  RMSE rRMSE
##    <int>      <dbl>         <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1    346     45738.          132.  27.7 -5.68  20.9  20.9 1582.  39.8  30.1
## # ... with 1 more variable: Modell <chr>

Grundlegende Implementierung - Warengruppe 2

Wir führen unsere Modellierung fort mit Warengruppe 2:

## n= 1061 
## 
## node), split, n, deviance, yval
##       * denotes terminal node
## 
##  1) root 1061 15929630.00 381.1674  
##    2) Monat_c=April,Dezember,Februar,Januar,Juni,Mai,März,November,Oktober,September 880  9116888.00 349.3631  
##      4) Wochenende< 0.5 627  3462522.00 309.6481  
##        8) Monat_c=Dezember,Februar,Januar,März,November 311   974238.00 266.7023 *
##        9) Monat_c=April,Juni,Mai,Oktober,September 316  1350177.00 351.9144  
##         18) Feiertag< 0.5 306   873680.80 345.4458 *
##         19) Feiertag>=0.5 10    71891.38 549.8540 *
##      5) Wochenende>=0.5 253  2214517.00 447.7873  
##       10) Monat_c=April,Dezember,Februar,Januar,März,November,Oktober 177  1463866.00 423.9788  
##         20) Wochentag_c=Samstag 89   631877.70 382.1070 *
##         21) Wochentag_c=Sonntag 88   518136.10 466.3265 *
##       11) Monat_c=Juni,Mai,September 76   416653.20 503.2361  
##         22) KielerWoche< 0.5 64   170999.50 483.3930 *
##         23) KielerWoche>=0.5 12    86054.56 609.0658 *
##    3) Monat_c=August,Juli 181  1594924.00 535.7956  
##      6) Wochentag_c=Dienstag,Donnerstag,Freitag,Mittwoch,Montag 128   788213.50 502.3090  
##       12) SommerferienNRW< 0.5 36   139970.00 438.1064 *
##       13) SommerferienNRW>=0.5 92   441786.40 527.4317  
##         26) SommerferienHE< 0.5 35   128025.80 472.8897 *
##         27) SommerferienHE>=0.5 57   145708.70 560.9225 *
##      7) Wochentag_c=Samstag,Sonntag 53   316529.90 616.6691 *

Sobald wir unser Modell angepasst haben, können wir einen Blick auf den dt1_WG2-Output werfen. Wir beginnen wieder mit 1061 Beobachtungen am Wurzelknoten (ganz am Anfang) und die erste Variable, die zur Teilung verwendet wird (also die erste Variable, die eine Reduzierung der SSE optimiert), ist bei dieser Warengruppe der Monat (Monat_c=April,Dezember,Februar,Januar,Juni,Mai,März,November,Oktober,September). Wir sehen, dass am ersten Knoten alle Beobachtungen mit Monat_c=April,Dezember,Februar,Januar,Juni,Mai,März,November,Oktober,September zum zweiten Zweig gehen. Die Gesamtzahl der Beobachtungen, die diesem Zweig folgen (880), der durchschnittliche Umsatz (266.70) und der SSE (974238.00) sind aufgeführt.

Wenn man nach dem 3. Zweig sucht, sieht man, dass 181 Beobachtungen mit Monat_c=August,Juli diesem Zweig folgen und ihre durchschnittlichen Umsätze 535.80€ betragen und der SSE hier 1594924.00 beträgt.

Grundsätzlich sagt uns dies, dass die wichtigste Variable, die anfangs den größten Rückgang der SSE aufweist, der Monat ist, wobei die durchschnittlichen Umsätze im August und Juli in der Warengruppe Brötchen um > 100% höher sind als in den Monaten April, Dezember, Februar, Januar, Juni, Mai, März, November, Oktober, September.

Wir visualisieren unser Modell mit erneut rpart.plot.

Man kann feststellen, dass dieser Baum 10 interne Knoten enthält, was zu 11 Endknoten führt.

Die gestrichelte Linie, die zwischen den Punkten | T | = 8 und 9 verläuft, deutet abermals darauf hin, dass auch ein kleiner Baum gewählt werden kann. Wir könnten nach der 1-SE-Regel auch einen Baum mit 8 oder 9 Endknoten verwenden und vernünftigerweise erwarten, dass innerhalb einer kleinen Fehlergrenze ähnliche Ergebnisse erzielt werden.

##            CP nsplit rel error    xerror       xstd
## 1  0.32755436      0 1.0000000 1.0012693 0.04110782
## 2  0.21594023      1 0.6724456 0.6745557 0.03329980
## 3  0.07144593      2 0.4565054 0.4586368 0.02605008
## 4  0.03077162      3 0.3850595 0.3875193 0.02517102
## 5  0.02539950      4 0.3542879 0.3644298 0.02447694
## 6  0.02096710      5 0.3288884 0.3600368 0.02434035
## 7  0.01970240      6 0.3079213 0.3477991 0.02325590
## 8  0.01296057      7 0.2882189 0.3131019 0.02035506
## 9  0.01054964      8 0.2752583 0.3020243 0.02053235
## 10 0.01001901      9 0.2647086 0.2917730 0.02030937
## 11 0.01000000     10 0.2546896 0.2908059 0.02023163

Tuning - Warengruppe 2

Neben dem Kostenkomplexität (α)-Parameter ist es auch üblich folgende Parameter anzupassen:

  • minsplit: Die Mindestanzahl von Datenpunkten, die erforderlich sind, um eine Teilung zu versuchen, bevor ein Endknoten erstellt werden muss. Der Standardwert ist 20. Wenn man diesen Wert verkleinert, können Endknoten, die möglicherweise nur eine Handvoll Beobachtungen enthalten, erstellt werden um den vorhergesagten Wert zu prognostizieren.
  • maxdepth: Die maximale Anzahl interner Knoten zwischen dem Wurzelknoten und den Endknoten. Der Standardwert ist 30, was ziemlich liberal ist und das Bauen ziemlich großer Bäume ermöglicht.

rpart verwendet ein spezielles Steuer- bzw. Kontrollargument, bei dem eine Liste von Hyperparameterwerten bereitgestellt wird. Wenn wir beispielsweise ein Modell mit minsplit = 20 und maxdepth = 12 bewerten möchten, können wir Folgendes ausführen:

##            CP nsplit rel error    xerror       xstd
## 1  0.32755436      0 1.0000000 1.0007664 0.04113994
## 2  0.21594023      1 0.6724456 0.6741514 0.03328318
## 3  0.07144593      2 0.4565054 0.4601160 0.02608776
## 4  0.03077162      3 0.3850595 0.3890275 0.02525570
## 5  0.02539950      4 0.3542879 0.3659798 0.02452663
## 6  0.02096710      5 0.3288884 0.3522389 0.02404580
## 7  0.01970240      6 0.3079213 0.3313761 0.02227937
## 8  0.01296057      7 0.2882189 0.3152145 0.02126868
## 9  0.01054964      8 0.2752583 0.2961458 0.02035452
## 10 0.01001901      9 0.2647086 0.2892959 0.02024347
## 11 0.01000000     10 0.2546896 0.2851367 0.02021604

Obwohl dieser Ansatz nützlich ist, müssen mehrere Modelle manuell bewertet werden. Besser ist es insofern eine Rastersuche durchzuführen, um automatisch nach einer Reihe unterschiedlich abgestimmter Modelle zu suchen, um die optimale Hyperparametereinstellung zu ermitteln.

Um eine Rastersuche durchzuführen, erstellen wir zuerst unser Hyperparameter-Raster. In diesem Beispiel suchen wir einen Bereich von minsplit von 5 bis 150 und variiere die maximale Tiefe von 8 bis 15 (da unser ursprüngliches Modell eine optimale Tiefe von 11 gefunden hat). Das Ergebnis sind 1168 verschiedene Kombinationen, für die 1168 verschiedene Modelle erforderlich sind.

##   minsplit maxdepth
## 1        5        8
## 2        6        8
## 3        7        8
## 4        8        8
## 5        9        8
## 6       10        8
## [1] 1168

Um die Modellierung zu automatisieren, richten wir einfach eine for-Schleife ein und durchlaufen jede Kombination aus minsplit und maxdepth. Wir speichern jedes Modell in einem eigenen Listenelement.

Wir erstellen erneut eine Funktion, um den minimalen Fehler zu extrahieren, der mit dem α-Wert der optimalen Kostenkomplexität für jedes Modell verbunden ist.

##   minsplit maxdepth   cp     error
## 1       44       12 0.01 0.2724936
## 2       56       10 0.01 0.2738537
## 3       10       11 0.01 0.2738740
## 4       20       15 0.01 0.2741688
## 5       56        9 0.01 0.2742891

Es ist erkennbar, dass das optimale Modell eine leichte Verbesserung gegenüber unserem früheren Modell darstellt (xerror von 0.2720379 gegenüber 0.2886208).

Wenn die Ergebnisse zufriedenstellend sind, kann dieses endgültige optimale Modell angewendet werden und auf dem Testsatz vorhersagen.

## [1] 65.51296

Der endgültige RMSE beträgt 65.51, was darauf hindeutet, dass unsere prognostizierten Umsätze im Durchschnitt etwa 65.51 € vom tatsächlichen Umsatz abweichen.

# Hinzufügen der Ergebnisse
df_dt_test_WG2 <- df_dt_test_WG2 %>%
  mutate(predicted = pred)

# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
df_dt_test_WG2 <- df_dt_test_WG2 %>%
  mutate(Prognose_zuhoch = (predicted >= Umsatz)) %>%
  mutate(Abweichung = predicted - Umsatz) %>%
  mutate(Abweichung_abs = abs(predicted - Umsatz)) %>%
  mutate(Abweichung_rel = (predicted - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Ergänze die benötigten Hilfsgrößen
df_dt_test_WG2 <- df_dt_test_WG2 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- df_dt_test_WG2 %>%
  group_by() %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz), 2), Umsatz_mittel = round(sum(Umsatz)/n(), 2), MAE = round(mean(Abweichung_abs), 2), MPE = round(mean(Abweichung_rel)*100, 2), MAPE = round(mean(Abweichung_rel_abs)*100, 2), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100, 2), MSE = round(mean(Abweichung_quad), 2), RMSE = round(sqrt(mean(Abweichung_quad)), 2), rRMSE = round(RMSE/Umsatz_mittel*100, 2))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "optimaltree_WG2")

# füge die Kennzahlen nun an die Vergleichstabelle
dt_vgl_kennz <- rbind(dt_vgl_kennz, temp)
dt_vgl_kennz
## # A tibble: 2 x 11
##   Anzahl Umsatz_ges Umsatz_mittel   MAE   MPE  MAPE  WAPE   MSE  RMSE rRMSE
##    <int>      <dbl>         <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1    346     45738.          132.  27.7 -5.68  20.9  20.9 1582.  39.8  30.1
## 2    346    130413.          377.  50.5  4.25  14.0  13.4 4292.  65.5  17.4
## # ... with 1 more variable: Modell <chr>

Grundlegende Implementierung - Warengruppe 3

Nachfolgend wird Warengruppe 3 behandelt.

## n= 1061 
## 
## node), split, n, deviance, yval
##       * denotes terminal node
## 
##  1) root 1061 4688829.00 149.55630  
##    2) Monat_c=April,Dezember,Februar,Januar,Juni,Mai,März,November,Oktober,September 880 1984950.00 129.36170  
##      4) Wochentag_c=Dienstag,Donnerstag,Freitag,Mittwoch,Montag 627  794490.20 113.85110  
##        8) Monat_c=Dezember,Februar,Januar,März,November 311  175179.10  93.59717 *
##        9) Monat_c=April,Juni,Mai,Oktober,September 316  366170.70 133.78470  
##         18) Feiertag< 0.5 306  274367.60 130.93840 *
##         19) Feiertag>=0.5 10   13469.92 220.87900 *
##      5) Wochentag_c=Samstag,Sonntag 253  665791.90 167.80090  
##       10) Monat_c=Dezember,Februar,Januar,März,November 122  129148.10 134.40700 *
##       11) Monat_c=April,Juni,Mai,Oktober,September 131  273892.80 198.90060  
##         22) Temperatur< 17.05 89  133836.20 183.32810 *
##         23) Temperatur>=17.05 42   72738.80 231.89950 *
##    3) Monat_c=August,Juli 181  600141.40 247.74020  
##      6) SommerferienHE< 0.5 69  139217.20 213.65300  
##       12) Wochentag_c=Dienstag,Donnerstag,Freitag,Mittwoch,Montag 45   62313.36 193.50270 *
##       13) Wochentag_c=Samstag,Sonntag 24   24372.70 251.43500 *
##      7) SommerferienHE>=0.5 112  331358.00 268.74040  
##       14) SommerferienNRW< 0.5 36   71561.49 225.35670 *
##       15) SommerferienNRW>=0.5 76  159943.80 289.29050 *

Der dt1_WG3-Output beginnt wieder mit 1061 Beobachtungen am Wurzelknoten (ganz am Anfang) und die erste Variable, die zur Teilung verwendet wird (also die erste Variable, die eine Reduzierung der SSE optimiert), ist bei dieser Warengruppe der Monat (Monat_c=April,Dezember,Februar,Januar,Juni,Mai,März,November,Oktober,September). Wir sehen, dass am ersten Knoten alle Beobachtungen mit Monat_c=April,Dezember,Februar,Januar,Juni,Mai,März,November,Oktober,September zum zweiten Zweig gehen. Die Gesamtzahl der Beobachtungen, die diesem Zweig folgen (880), der durchschnittliche Umsatz (266.70) und der SSE (974238.00) sind aufgeführt.

Wenn man nach dem 3. Zweig sucht, sieht man, dass 181 Beobachtungen mit Monat_c=August,Juli diesem Zweig folgen und ihre durchschnittlichen Umsätze 535.80€ betragen und der SSE hier 1594924.00 beträgt.

Grundsätzlich sagt uns dies, dass die wichtigste Variable, die anfangs den größten Rückgang der SSE aufweist, der Monat ist, wobei die durchschnittlichen Umsätze im August und Juli in der Warengruppe Brötchen um > 100% höher sind als in den Monaten April, Dezember, Februar, Januar, Juni, Mai, März, November, Oktober, September.

Wir visualisieren unser Modell mit erneut rpart.plot.

Man kann feststellen, dass dieser Baum 9 interne Knoten enthält, was zu 10 Endknoten führt.

Die gestrichelte Linie, die durch den Punkt | T | = 9 verläuft, deutet abermals darauf hin, dass auch ein kleiner Baum gewählt werden kann. Wir könnten nach der 1-SE-Regel auch einen Baum mit 9 Endknoten verwenden und vernünftigerweise erwarten, dass innerhalb einer kleinen Fehlergrenze ähnliche Ergebnisse erzielt werden.

##            CP nsplit rel error    xerror       xstd
## 1  0.44867020      0 1.0000000 1.0015279 0.04971309
## 2  0.11189740      1 0.5513298 0.5546683 0.03009868
## 3  0.05603766      2 0.4394324 0.4460590 0.02348475
## 4  0.05398798      3 0.3833947 0.4015676 0.02291717
## 5  0.02763295      4 0.3294068 0.3402855 0.02049322
## 6  0.02129588      5 0.3017738 0.3150922 0.01953374
## 7  0.01670633      6 0.2804779 0.2964034 0.01856218
## 8  0.01435706      7 0.2637716 0.2795737 0.01817929
## 9  0.01120346      8 0.2494145 0.2724281 0.01796532
## 10 0.01000000      9 0.2382111 0.2574988 0.01688923

Tuning - Warengruppe 3

Neben dem Kostenkomplexität (α)-Parameter ist es auch üblich folgende Parameter anzupassen:

  • minsplit: Die Mindestanzahl von Datenpunkten, die erforderlich sind, um eine Teilung zu versuchen, bevor ein Endknoten erstellt werden muss. Der Standardwert ist 20. Wenn man diesen Wert verkleinert, können Endknoten, die möglicherweise nur eine Handvoll Beobachtungen enthalten, erstellt werden um den vorhergesagten Wert zu prognostizieren.
  • maxdepth: Die maximale Anzahl interner Knoten zwischen dem Wurzelknoten und den Endknoten. Der Standardwert ist 30, was ziemlich liberal ist und das Bauen ziemlich großer Bäume ermöglicht.

rpart verwendet ein spezielles Steuer- bzw. Kontrollargument, bei dem eine Liste von Hyperparameterwerten bereitgestellt wird. Wenn wir beispielsweise ein Modell mit minsplit = 20 und maxdepth = 12 bewerten möchten, können wir Folgendes ausführen:

##            CP nsplit rel error    xerror       xstd
## 1  0.44867020      0 1.0000000 1.0014182 0.04975427
## 2  0.11189740      1 0.5513298 0.5537230 0.03011577
## 3  0.05603766      2 0.4394324 0.4417937 0.02467796
## 4  0.05398798      3 0.3833947 0.4224528 0.02481088
## 5  0.02763295      4 0.3294068 0.3544683 0.02304497
## 6  0.02129588      5 0.3017738 0.3235763 0.02228344
## 7  0.01670633      6 0.2804779 0.3039682 0.02147273
## 8  0.01435706      7 0.2637716 0.3053851 0.02142735
## 9  0.01120346      8 0.2494145 0.2899149 0.02038217
## 10 0.01000000      9 0.2382111 0.2660729 0.01887073

Obwohl dieser Ansatz nützlich ist, müssen mehrere Modelle manuell bewertet werden. Besser ist es insofern eine Rastersuche durchzuführen, um automatisch nach einer Reihe unterschiedlich abgestimmter Modelle zu suchen, um die optimale Hyperparametereinstellung zu ermitteln.

Um eine Rastersuche durchzuführen, erstellen wir zuerst unser Hyperparameter-Raster. In diesem Beispiel suchen wir einen Bereich von minsplit von 5 bis 150 und variiere die maximale Tiefe von 8 bis 15 (da unser ursprüngliches Modell eine optimale Tiefe von 11 gefunden hat). Das Ergebnis sind 1168 verschiedene Kombinationen, für die 1168 verschiedene Modelle erforderlich sind.

##   minsplit maxdepth
## 1        5        8
## 2        6        8
## 3        7        8
## 4        8        8
## 5        9        8
## 6       10        8
## [1] 1168

Um die Modellierung zu automatisieren, richten wir einfach eine for-Schleife ein und durchlaufen jede Kombination aus minsplit und maxdepth. Wir speichern jedes Modell in einem eigenen Listenelement.

Wir erstellen erneut eine Funktion, um den minimalen Fehler zu extrahieren, der mit dem α-Wert der optimalen Kostenkomplexität für jedes Modell verbunden ist.

##   minsplit maxdepth   cp     error
## 1        8        9 0.01 0.2477044
## 2        6       10 0.01 0.2482733
## 3       24       14 0.01 0.2483765
## 4        6       13 0.01 0.2484114
## 5       18       14 0.01 0.2485533

Es ist erkennbar, dass das optimale Modell eine leichte Verbesserung gegenüber unserem früheren Modell darstellt (xerror von 0.2488002 gegenüber 0.2652715).

Wenn die Ergebnisse zufriedenstellend sind, kann dieses endgültige optimale Modell angewendet werden und auf dem Testsatz vorhersagen.

## [1] 50.81046

Der endgültige RMSE beträgt 50.81, was darauf hindeutet, dass unsere prognostizierten Umsätze im Durchschnitt etwa 50.81 € vom tatsächlichen Umsatz abweichen.

# Hinzufügen der Ergebnisse
df_dt_test_WG3 <- df_dt_test_WG3 %>%
  mutate(predicted = pred)

# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
df_dt_test_WG3 <- df_dt_test_WG3 %>%
  mutate(Prognose_zuhoch = (predicted >= Umsatz)) %>%
  mutate(Abweichung = predicted - Umsatz) %>%
  mutate(Abweichung_abs = abs(predicted - Umsatz)) %>%
  mutate(Abweichung_rel = (predicted - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Ergänze die benötigten Hilfsgrößen
df_dt_test_WG3 <- df_dt_test_WG3 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- df_dt_test_WG3 %>%
  group_by() %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz), 2), Umsatz_mittel = round(sum(Umsatz)/n(), 2), MAE = round(mean(Abweichung_abs), 2), MPE = round(mean(Abweichung_rel)*100, 2), MAPE = round(mean(Abweichung_rel_abs)*100, 2), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100, 2), MSE = round(mean(Abweichung_quad), 2), RMSE = round(sqrt(mean(Abweichung_quad)), 2), rRMSE = round(RMSE/Umsatz_mittel*100, 2))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "optimaltree_WG3")

# füge die Kennzahlen nun an die Vergleichstabelle
dt_vgl_kennz <- rbind(dt_vgl_kennz, temp)
dt_vgl_kennz
## # A tibble: 3 x 11
##   Anzahl Umsatz_ges Umsatz_mittel   MAE   MPE  MAPE  WAPE   MSE  RMSE rRMSE
##    <int>      <dbl>         <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1    346     45738.          132.  27.7 -5.68  20.9  20.9 1582.  39.8  30.1
## 2    346    130413.          377.  50.5  4.25  14.0  13.4 4292.  65.5  17.4
## 3    346     59316.          171.  36.1 -7.43  19.7  21.0 2582.  50.8  29.6
## # ... with 1 more variable: Modell <chr>

Grundlegende Implementierung - Warengruppe 4

Da ganze Procedere wird nun auf Warengruppe 4 angewendet.

## n= 1047 
## 
## node), split, n, deviance, yval
##       * denotes terminal node
## 
##  1) root 1047 1285575.000  88.63587  
##    2) Wochentag_c=Dienstag,Donnerstag,Freitag,Mittwoch,Montag,Samstag 895  632802.600  81.13245  
##      4) Monat_c=April,Dezember,Januar,Juli,Juni,Mai,März,November,Oktober,September 743  332338.500  76.89122  
##        8) Feiertag< 0.5 730  269455.300  75.96748 *
##        9) Feiertag>=0.5 13   27281.310 128.76310 *
##      5) Monat_c=August,Februar 152  221768.500 101.86420  
##       10) Datum>=16852 84   62037.990  90.48571 *
##       11) Datum< 16852 68  135420.600 115.92000  
##         22) Datum< 16832.5 51   61072.870 100.49370  
##           44) Datum>=16488 33   15123.660  83.02606 *
##           45) Datum< 16488 18   17420.550 132.51780 *
##         23) Datum>=16832.5 17   25801.840 162.19880 *
##    3) Wochentag_c=Sonntag 152  305680.200 132.81720  
##      6) Monat_c=April,August,Dezember,Januar,Juli,Juni,Mai,März,November,Oktober,September 140  179885.100 125.92110  
##       12) Monat_c=Juli,Juni 26   18393.320  99.25923 *
##       13) Monat_c=April,August,Dezember,Januar,Mai,März,November,Oktober,September 114  138794.300 132.00180  
##         26) Datum>=17475 8    6562.069  90.20625 *
##         27) Datum< 17475 106  117202.500 135.15620 *
##      7) Monat_c=Februar 12   41460.560 213.27250 *

Der dt1_WG4-Output beginnt mit 1047 Beobachtungen am Wurzelknoten (ganz am Anfang) und die erste Variable, die zur Teilung verwendet wird (also die erste Variable, die eine Reduzierung der SSE optimiert), ist bei dieser Warengruppe der Wochentag (Wochentag_c=Dienstag,Donnerstag,Freitag,Mittwoch,Montag,Samstag). Wir sehen, dass am ersten Knoten alle Beobachtungen mit Wochentag_c=Dienstag,Donnerstag,Freitag,Mittwoch,Montag,Samstag zum zweiten Zweig gehen. Die Gesamtzahl der Beobachtungen, die diesem Zweig folgen (895), der durchschnittliche Umsatz (81.13) und der SSE (632802.600) sind aufgeführt.

Wenn man nach dem 3. Zweig sucht, sieht man, dass 152 Beobachtungen mit 3) Wochentag_c=Sonntag diesem Zweig folgen und ihre durchschnittlichen Umsätze 132.82€ betragen und der SSE hier 305680.200 beträgt.

Grundsätzlich sagt uns dies, dass die wichtigste Variable, die anfangs den größten Rückgang der SSE aufweist, der Wochentag ist, wobei die durchschnittlichen Umsätze am Sonntag in der Warengruppe Kuchen um > 64% höher sind als an den anderen Wochentagen.

Wir visualisieren unser Modell mit erneut rpart.plot.

Man kann feststellen, dass dieser Baum 9 interne Knoten enthält, was zu 10 Endknoten führt.

Die gestrichelte Linie, die etwa durch den Punkt | T | = 8 verläuft, deutet abermals darauf hin, dass auch ein kleiner Baum gewählt werden kann. Wir könnten nach der 1-SE-Regel auch einen Baum mit 8 Endknoten verwenden und vernünftigerweise erwarten, dass innerhalb einer kleinen Fehlergrenze ähnliche Ergebnisse erzielt werden.

##           CP nsplit rel error    xerror       xstd
## 1 0.26999013      0 1.0000000 1.0012219 0.08763196
## 2 0.06560065      1 0.7300099 0.7341502 0.06502506
## 3 0.06121428      2 0.6644092 0.7336132 0.06465325
## 4 0.02833587      3 0.6031949 0.6392667 0.04655143
## 5 0.02769333      5 0.5465232 0.6283016 0.04649345
## 6 0.02219135      6 0.5188299 0.6237339 0.04617231
## 7 0.01765547      7 0.4966385 0.5739615 0.04213528
## 8 0.01169102      8 0.4789830 0.5305355 0.03616880
## 9 0.01000000      9 0.4672920 0.5296359 0.03621191

Tuning - Warengruppe 4

Neben dem Kostenkomplexität (α)-Parameter ist es auch üblich folgende Parameter anzupassen:

  • minsplit: Die Mindestanzahl von Datenpunkten, die erforderlich sind, um eine Teilung zu versuchen, bevor ein Endknoten erstellt werden muss. Der Standardwert ist 20. Wenn man diesen Wert verkleinert, können Endknoten, die möglicherweise nur eine Handvoll Beobachtungen enthalten, erstellt werden um den vorhergesagten Wert zu prognostizieren.
  • maxdepth: Die maximale Anzahl interner Knoten zwischen dem Wurzelknoten und den Endknoten. Der Standardwert ist 30, was ziemlich liberal ist und das Bauen ziemlich großer Bäume ermöglicht.

rpart verwendet ein spezielles Steuer- bzw. Kontrollargument, bei dem eine Liste von Hyperparameterwerten bereitgestellt wird. Wenn wir beispielsweise ein Modell mit minsplit = 20 und maxdepth = 12 bewerten möchten, können wir Folgendes ausführen:

##           CP nsplit rel error    xerror       xstd
## 1 0.26999013      0 1.0000000 1.0025439 0.08770851
## 2 0.06560065      1 0.7300099 0.7353085 0.06492046
## 3 0.06121428      2 0.6644092 0.7372401 0.06435780
## 4 0.02833587      3 0.6031949 0.6202476 0.04465614
## 5 0.02769333      5 0.5465232 0.6257745 0.04522206
## 6 0.02219135      6 0.5188299 0.6081746 0.04388151
## 7 0.01765547      7 0.4966385 0.5902438 0.04050024
## 8 0.01169102      8 0.4789830 0.5654687 0.03751229
## 9 0.01000000      9 0.4672920 0.5447727 0.03565638

Obwohl dieser Ansatz nützlich ist, müssen mehrere Modelle manuell bewertet werden. Besser ist es insofern eine Rastersuche durchzuführen, um automatisch nach einer Reihe unterschiedlich abgestimmter Modelle zu suchen, um die optimale Hyperparametereinstellung zu ermitteln.

Um eine Rastersuche durchzuführen, erstellen wir zuerst unser Hyperparameter-Raster. In diesem Beispiel suchen wir einen Bereich von minsplit von 5 bis 150 und variiere die maximale Tiefe von 8 bis 15 (da unser ursprüngliches Modell eine optimale Tiefe von 11 gefunden hat). Das Ergebnis sind 1168 verschiedene Kombinationen, für die 1168 verschiedene Modelle erforderlich sind.

##   minsplit maxdepth
## 1        5        8
## 2        6        8
## 3        7        8
## 4        8        8
## 5        9        8
## 6       10        8
## [1] 1168

Um die Modellierung zu automatisieren, richten wir einfach eine for-Schleife ein und durchlaufen jede Kombination aus minsplit und maxdepth. Wir speichern jedes Modell in einem eigenen Listenelement.

Wir erstellen erneut eine Funktion, um den minimalen Fehler zu extrahieren, der mit dem α-Wert der optimalen Kostenkomplexität für jedes Modell verbunden ist.

##   minsplit maxdepth   cp     error
## 1        8       12 0.01 0.4988697
## 2       25       15 0.01 0.5067534
## 3        8       10 0.01 0.5070490
## 4        5        8 0.01 0.5112461
## 5        6       14 0.01 0.5114026

Es ist erkennbar, dass das optimale Modell eine leichte Verbesserung gegenüber unserem früheren Modell darstellt (xerror von 0.5018793 gegenüber 0.5157798).

Wenn die Ergebnisse zufriedenstellend sind, kann dieses endgültige optimale Modell angewendet werden und auf dem Testsatz vorhersagen.

## [1] 24.31214

Der endgültige RMSE beträgt 24.31, was darauf hindeutet, dass unsere prognostizierten Umsätze im Durchschnitt etwa 24.31 € vom tatsächlichen Umsatz abweichen.

# Hinzufügen der Ergebnisse
df_dt_test_WG4 <- df_dt_test_WG4 %>%
  mutate(predicted = pred)

# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
df_dt_test_WG4 <- df_dt_test_WG4 %>%
  mutate(Prognose_zuhoch = (predicted >= Umsatz)) %>%
  mutate(Abweichung = predicted - Umsatz) %>%
  mutate(Abweichung_abs = abs(predicted - Umsatz)) %>%
  mutate(Abweichung_rel = (predicted - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Ergänze die benötigten Hilfsgrößen
df_dt_test_WG4 <- df_dt_test_WG4 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- df_dt_test_WG4 %>%
  group_by() %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz), 2), Umsatz_mittel = round(sum(Umsatz)/n(), 2), MAE = round(mean(Abweichung_abs), 2), MPE = round(mean(Abweichung_rel)*100, 2), MAPE = round(mean(Abweichung_rel_abs)*100, 2), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100, 2), MSE = round(mean(Abweichung_quad), 2), RMSE = round(sqrt(mean(Abweichung_quad)), 2), rRMSE = round(RMSE/Umsatz_mittel*100, 2))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "optimaltree_WG4")

# füge die Kennzahlen nun an die Vergleichstabelle
dt_vgl_kennz <- rbind(dt_vgl_kennz, temp)
dt_vgl_kennz
## # A tibble: 4 x 11
##   Anzahl Umsatz_ges Umsatz_mittel   MAE   MPE  MAPE  WAPE   MSE  RMSE rRMSE
##    <int>      <dbl>         <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1    346     45738.         132.   27.7 -5.68  20.9  20.9 1582.  39.8  30.1
## 2    346    130413.         377.   50.5  4.25  14.0  13.4 4292.  65.5  17.4
## 3    346     59316.         171.   36.1 -7.43  19.7  21.0 2582.  50.8  29.6
## 4    345     28354.          82.2  17.3  6.35  22.2  21.1  591.  24.3  29.6
## # ... with 1 more variable: Modell <chr>

Grundlegende Implementierung - Warengruppe 5

Abschließend wird nun noch ein Entscheidungsbaum für Warengruppe 5 erstellt.

## n= 1061 
## 
## node), split, n, deviance, yval
##       * denotes terminal node
## 
##  1) root 1061 9542791.00 265.6068  
##    2) Feiertag< 0.5 1040 3458236.00 260.8128  
##      4) Wochentag_c=Dienstag,Donnerstag,Freitag,Mittwoch,Montag 743 1693783.00 246.5031  
##        8) Monat_c=April,Dezember,Januar,März,November 307  586213.20 221.0646  
##         16) Herbst>=0.5 102   75452.36 190.8896 *
##         17) Herbst< 0.5 205  371676.30 236.0785 *
##        9) Monat_c=August,Februar,Juli,Juni,Mai,Oktober,September 436  769020.00 264.4150  
##         18) SommerferienSH< 0.5 347  492842.40 255.5571 *
##         19) SommerferienSH>=0.5 89  142797.40 298.9510 *
##      5) Wochentag_c=Samstag,Sonntag 297 1231696.00 296.6112  
##       10) Monat_c=April,Dezember,Januar,Juli,Juni,Mai,März,November,Oktober 223  757522.10 282.9643 *
##       11) Monat_c=August,Februar,September 74  307486.50 337.7366 *
##    3) Feiertag>=0.5 21 4876955.00 503.0233  
##      6) Bewoelkung< 6.5 13   10042.37 297.9608 *
##      7) Bewoelkung>=6.5 8 3431934.00 836.2500 *

Der dt1_WG5-Output beginnt mit 1061 Beobachtungen am Wurzelknoten (ganz am Anfang) und die erste Variable, die zur Teilung verwendet wird (also die erste Variable, die eine Reduzierung der SSE optimiert), ist bei dieser Warengruppe der Feiertag. Wir sehen, dass am ersten Knoten alle Beobachtungen mit Feiertag< 0.5 zum zweiten Zweig gehen. Die Gesamtzahl der Beobachtungen, die diesem Zweig folgen (743), der durchschnittliche Umsatz (246.50) und der SSE (1693783.00) sind aufgeführt.

Wenn man nach dem 3. Zweig sucht, sieht man, dass 21 Beobachtungen mit Feiertag> 0.5 diesem Zweig folgen und ihre durchschnittlichen Umsätze 503.02€ betragen und der SSE hier 4876955.00 beträgt.

Grundsätzlich sagt uns dies, dass die wichtigste Variable, die anfangs den größten Rückgang der SSE aufweist, der Feiertag ist, wobei die durchschnittlichen Umsätze am Feiertag in der Warengruppe Konditorei um > 100% höher sind als an den Nicht-Feiertagen.

Wir visualisieren unser Modell mit erneut rpart.plot.

Man kann feststellen, dass dieser Baum 7 interne Knoten enthält, was zu 8 Endknoten führt.

Die gestrichelte Linie verläuft hier durch keinen Punkt. Ein Baum mit 8 Knoten ist somit scheinbar der kleinstmögliche.

##           CP nsplit rel error    xerror      xstd
## 1 0.13845945      0 1.0000000 1.0021356 0.3746202
## 2 0.05582824      2 0.7230811 1.0027495 0.3613000
## 3 0.03547701      3 0.6672529 0.9055858 0.3342628
## 4 0.01746737      4 0.6317759 0.8863457 0.3415337
## 5 0.01457483      5 0.6143085 0.8756497 0.3415724
## 6 0.01397706      6 0.5997337 0.8659983 0.3373040
## 7 0.01000000      7 0.5857566 0.8546963 0.3373062

Tuning - Warengruppe 5

Neben dem Kostenkomplexität (α)-Parameter ist es auch üblich folgende Parameter anzupassen:

  • minsplit: Die Mindestanzahl von Datenpunkten, die erforderlich sind, um eine Teilung zu versuchen, bevor ein Endknoten erstellt werden muss. Der Standardwert ist 20. Wenn man diesen Wert verkleinert, können Endknoten, die möglicherweise nur eine Handvoll Beobachtungen enthalten, erstellt werden um den vorhergesagten Wert zu prognostizieren.
  • maxdepth: Die maximale Anzahl interner Knoten zwischen dem Wurzelknoten und den Endknoten. Der Standardwert ist 30, was ziemlich liberal ist und das Bauen ziemlich großer Bäume ermöglicht.

rpart verwendet ein spezielles Steuer- bzw. Kontrollargument, bei dem eine Liste von Hyperparameterwerten bereitgestellt wird. Wenn wir beispielsweise ein Modell mit minsplit = 20 und maxdepth = 10 bewerten möchten, können wir Folgendes ausführen:

##           CP nsplit rel error    xerror      xstd
## 1 0.13845945      0 1.0000000 1.0018231 0.3744881
## 2 0.05582824      2 0.7230811 1.0414984 0.3599096
## 3 0.03547701      3 0.6672529 0.9504436 0.3347433
## 4 0.01746737      4 0.6317759 0.9218563 0.3419942
## 5 0.01457483      5 0.6143085 0.9106649 0.3419824
## 6 0.01397706      6 0.5997337 0.8960999 0.3378096
## 7 0.01000000      7 0.5857566 0.8790114 0.3378136

Obwohl dieser Ansatz nützlich ist, müssen mehrere Modelle manuell bewertet werden. Besser ist es insofern eine Rastersuche durchzuführen, um automatisch nach einer Reihe unterschiedlich abgestimmter Modelle zu suchen, um die optimale Hyperparametereinstellung zu ermitteln.

Um eine Rastersuche durchzuführen, erstellen wir zuerst unser Hyperparameter-Raster. In diesem Beispiel suchen wir einen Bereich von minsplit von 5 bis 150 und variiere die maximale Tiefe von 8 bis 15 (da unser ursprüngliches Modell eine optimale Tiefe von 11 gefunden hat). Das Ergebnis sind 1168 verschiedene Kombinationen, für die 208 verschiedene Modelle erforderlich sind.

##   minsplit maxdepth
## 1        5        8
## 2        6        8
## 3        7        8
## 4        8        8
## 5        9        8
## 6       10        8
## [1] 208

Um die Modellierung zu automatisieren, richten wir einfach eine for-Schleife ein und durchlaufen jede Kombination aus minsplit und maxdepth. Wir speichern jedes Modell in einem eigenen Listenelement.

Wir erstellen erneut eine Funktion, um den minimalen Fehler zu extrahieren, der mit dem α-Wert der optimalen Kostenkomplexität für jedes Modell verbunden ist.

##   minsplit maxdepth   cp     error
## 1       15       12 0.01 0.6939512
## 2       12       11 0.01 0.6958244
## 3        8       14 0.01 0.7075806
## 4        9       10 0.01 0.7105965
## 5        8       12 0.01 0.7296183

Es ist erkennbar, dass das optimale Modell eine deutliche Verbesserung gegenüber unserem früheren Modell darstellt (xerror von 0.6213613 gegenüber 0.7828373).

Wenn die Ergebnisse zufriedenstellend sind, kann dieses endgültige optimale Modell angewendet werden und auf dem Testsatz vorhersagen.

## [1] 68.6513

Der endgültige RMSE beträgt 68.65, was darauf hindeutet, dass unsere prognostizierten Umsätze im Durchschnitt etwa 68.65 € vom tatsächlichen Umsatz abweichen.

# Hinzufügen der Ergebnisse
df_dt_test_WG5 <- df_dt_test_WG5 %>%
  mutate(predicted = pred)

# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
df_dt_test_WG5 <- df_dt_test_WG5 %>%
  mutate(Prognose_zuhoch = (predicted >= Umsatz)) %>%
  mutate(Abweichung = predicted - Umsatz) %>%
  mutate(Abweichung_abs = abs(predicted - Umsatz)) %>%
  mutate(Abweichung_rel = (predicted - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Ergänze die benötigten Hilfsgrößen
df_dt_test_WG5 <- df_dt_test_WG5 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- df_dt_test_WG5 %>%
  group_by() %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz), 2), Umsatz_mittel = round(sum(Umsatz)/n(), 2), MAE = round(mean(Abweichung_abs), 2), MPE = round(mean(Abweichung_rel)*100, 2), MAPE = round(mean(Abweichung_rel_abs)*100, 2), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100, 2), MSE = round(mean(Abweichung_quad), 2), RMSE = round(sqrt(mean(Abweichung_quad)), 2), rRMSE = round(RMSE/Umsatz_mittel*100, 2))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "optimaltree_WG5")

# füge die Kennzahlen nun an die Vergleichstabelle
dt_vgl_kennz <- rbind(dt_vgl_kennz, temp)
dt_vgl_kennz
## # A tibble: 5 x 11
##   Anzahl Umsatz_ges Umsatz_mittel   MAE   MPE  MAPE  WAPE   MSE  RMSE rRMSE
##    <int>      <dbl>         <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1    346     45738.         132.   27.7 -5.68  20.9  20.9 1582.  39.8  30.1
## 2    346    130413.         377.   50.5  4.25  14.0  13.4 4292.  65.5  17.4
## 3    346     59316.         171.   36.1 -7.43  19.7  21.0 2582.  50.8  29.6
## 4    345     28354.          82.2  17.3  6.35  22.2  21.1  591.  24.3  29.6
## 5    346     93912.         271.   41.1  0.37  14.6  15.2 4713   68.6  25.3
## # ... with 1 more variable: Modell <chr>

7.4 Fazit Decision Trees

Die Decision Trees liefern vergleichsweise gute Schätzwerte für die Warengruppen 4 (= Konditorei) und 5 (= Kuchen). Für Warengruppe 4 performt der Entscheidungsbaum insgesamt (deutlich) besser als das lineare Modell, aber immer noch schlechter als das naive. Das naive Modell liefert dabei insbesondere bessere Werte für den MPE, den WAPE sowie RMSE und rRMSE. Was Warengruppe 5 anbelangt, bleibt der Entscheidungsbaum knapp hinter dem linearen Modell zurück, was vor allem auf deutlich höhere Werte bei den Kennzahlen MSE, RMSE sowie rRMSE zurückzuführen ist.

Anders sieht es bei den verbleibenden Warengruppen 1, 2, und 3 aus. Zwar liefert der Entscheidungsbaum für Warengruppe 1 bessere Werte als das naive Modell, performt aber andereseits deutlich schlechter als das lineare Modell. In den anderen Warengruppen 2 und 3 landen die Entscheidungsbäume hinter den anderen getesteten Modellen. Am schlechtesten scheinen Entscheidungsbäume für die Prognose der Umsätze in der Warengruppe 3 zu sein. Für diese Warengruppe ergeben sich deutlich schlechtere Werte bei nahezu allen Gütekennzahlen (Ausnahme: der MPE, der beim lm -8 und beim DT -7 beträgt).

Allgemein betrachtet noch folende Ergänzungen:

Stärken und Schwächen

Regressionsbäume bieten mehrere Vorteile:

  • Sie sind sehr gut / einfach interpretierbar.
  • Vorhersagen zu treffen geht vglw. schnell (keine komplizierten Berechnungen, nur nach Konstanten im Baum suchen).
  • Es ist leicht zu verstehen, welche Variablen für die Vorhersage wichtig sind. Die internen Knoten (Splits) sind diejenigen Variablen, die die SSE am stärksten reduziert haben.
  • Wenn einige Daten fehlen, können wir möglicherweise nicht den ganzen Weg den Baum hinunter zu einem Blatt gehen, aber wir können trotzdem eine Vorhersage treffen, indem wir alle Blätter in dem Teilbaum mitteln, den wir erreichen.
  • Das Modell bietet eine nichtlineare „gezackte“ Antwort, sodass es funktionieren kann, wenn die wahre Regressionsfläche nicht “glatt” ist. Wenn es jedoch glatt ist, kann die stückweise konstante Oberfläche es beliebig genau annähern (mit genügend Blättern).
  • Es gibt schnelle und zuverlässige Algorithmen, um diese Bäume zu lernen.

Es gibt aber auch einige wesentliche Schwächen:

  • Einzelne Regressionsbäume weisen eine hohe Varianz auf, was zu instabilen Vorhersagen führt (eine alternative Teilstichprobe von Trainingsdaten kann die Endknoten erheblich verändern).
  • Aufgrund der hohen Varianz weisen einzelne Regressionsbäume eine schlechte Vorhersagegenauigkeit auf.

8 Anwendung von ML Verfahren: Support Vector Machines (SVM)

8.1 Vorhaben und Theorie

Wir testen nun ein anerkanntes Verfahren aus dem Bereich Machine Learning (ML), nämlich Support Vector Machines (SVM). Dieses Verfahren wird häufig für die Klassifizierung verwendet, kann jedoch auch zur Lösung von Regressions-Problemen verwendet werden. Genau das wollen wir tun.

Lineare SVM zur Klassifizierung

In der einfachsten Form hat man ein Trainingsset \(D=\{(\vec{x}^{(1)},y^{(1)}),...,(\vec{x}^{(p)},y^{(p)})\}\) bestehend aus \(p\) Eingabevektoren \(\vec{x}\) mit zugehörigem Label \(y\), beispielsweise \(+1\) und \(-1\).

Im Bild sehen wir ein Beispiel in zwei Dimensionen: Die roten Quadrate haben Label \(+1\), die grünen Kreise \(-1\). Man sucht dann die Trennlinie (durchgezogene Linie), die den Sicherheitsabstand (“Marge” oder engl. “margin”) maximiert. Dir Grenzen der Sicherheitszone sind durch die gestrichelten Linien gezeigt. Die Datenpunkte, die direkt auf den getrennten Linien liegen haben als Abstand gerade die doppelte Marge und werden als Support-Vektoren bezeichnet. Für die Lösung des Problems sind nämlich gerade die Support-Vektoren entscheidend.

Die Trennlinie (in höheren Dimensionen Hyperebene) lässt sich beschreiben als \(H=\{\vec{x}|\vec{w}^T\cdot\vec{x}+b=0\}\). Dabei bezeichnet \(\vec{w}\) den Normal-Vektor der Hyperebene. Und als Lösung erhalten wir eine Klassifizierungsfunktion \(f(\vec{x})=sgn(\vec{w}^T\cdot\vec{x}+b)\). Dieser Klassifizierer ist unsere Support Vector Machine.

Das Problem ist, dass die Hyperebene durch \(\vec{w}\) nicht eindeutig bestimmt ist. Wir legen daher durch Normierung die sogenannte kanonische Hyperebene fest. Konkret erreichen wir das durch die Nebenbedingungen \((*)\): \(\vec{w}^T\cdot\vec{x}+b \ge +1\) für Support-Vektoren mit Label \(+1\) und \(\vec{w}^T\cdot\vec{x}+b \le -1\) für Support-Vektoren mit Label \(-1\). Damit ergibt sich der Sicherheitsabstand zwischen den beiden gestrichelten Linien zu \(\frac{2}{||\vec{w}||}\).

Jetzt haben wir ein Optimierungsproblem und müssen \(||\vec{w}||\) minimieren, um den Sicherheitsabstand zu maximieren, unter den Nebenbedingungen \((*)\). Bei der Lösung kommen Lagrange-Multiplikatoren \(\alpha_\mu\ge0\) ins Spiel und liefern als Lösung die optimalen Werte \(\vec{w}^*\) und \(b^*\) mit \(\vec{w}^*=\sum_{\mu=1}^{p}\alpha_\mu y^{(\mu)}\vec{x}^{(\mu)}\). Die Details sparen wir an dieser Stelle aus.

Damit erhalten wir die Klassifizierungsfunktion \(f(\vec{x})=sgn(\vec{w}^{*T}\cdot\vec{x}+b^*)=sgn(\sum_{\mu=1}^{p}\alpha_\mu y^{(\mu)}\vec{x}^{(\mu)T}\cdot\vec{x}+b^*)\).

Klassifizierung von linear nicht trennbaren Datensätzen

SVM kann auch angewendet werden, wenn keine scharfe Trennung zwischen den Klassen möglich ist. In solchen Fällen verwendet man die sogenannte Soft-Margin-Klassifizierung. Ziel dabei ist eine Trennlinie zu finden, die die Anzahl der Punkte innerhalb des Sicherheitsabstandes minimiert bzw. die Anzahl der falsch klassifizierten Datenpunkte minimiert. Durch diese Nebenbedingung kommt ein weiterer Parameter \(C\) (“cost”) ins Spiel.

Nicht-lineare SVM zur Klassifizierung

Bislang haben skizziert, wie man SVM auf linear trennbare Datensätze anwendet - abgesehen von einigen Überlappungen der Daten unterschiedlicher Klassen. Aber SVM kann noch mehr:

Im oberen Teil der Abbildung sehen wir Daten zweier Klassen (rote und blaue Kreise), die in einer Dimension linear nicht trennbar sind. Transformiert man die Daten jedoch in eine höhere Dimension (hier 2D) durch eine Funktion \(\vec{x}\rightarrow\Phi(\vec{x})\), sieht man, dass die Klassen nun linear trennbar sind. Man spricht von einer Transformation in den höher-dimensionalen “Feature-Raum” und führt dann SVM eben in diesem Feature-Raum durch.

Dabei nutzt man aus, dass die transformierten Eingabevektoren \(\Phi(\vec{x})\) nur in Form von Skalarprodukten auftauchen und definiert eine sogenannte Kernel-Funktion \(k(.,.)\), um den Zusammenhang zwischen Eingabevektoren und transformierten Eingabevektoren im Feature-Raum zu vereinfachen: \(k(\vec{x},\vec{y})=\Phi(\vec{x})^T\cdot\Phi(\vec{y})\).

Wir verwenden später als Kernel \(k(\vec{x},\vec{y})=exp(-\gamma(\vec{x}-\vec{y})^2)\), also eine Gauss-Funktion, die man auch als “Radial-Basis-Funktion” (rbf) bezeichnet. Unsere Klassifizierungsfunktion wird dann zu:

\(f(\vec{x})=sgn(\sum_{\mu=1}^{p}\alpha_\mu y^{(\mu)}\Phi(\vec{x}^{(\mu)})^T\cdot\Phi(\vec{x})+b^*)=sgn(\sum_{\mu=1}^{p}\alpha_\mu y^{(\mu)}k(\vec{x}^{(\mu)},\vec{x})+b^*)\).

SVM zur Regression

Verzichten wir in der Klassifizierungsfunktion \(f(.)\) auf \(sgn(.)\) und verwenden stattdessen nur das Argument, dann können wir SVM auch auf Regressions-Probleme anwenden. Wir wollen dabei eine Funktion \(f(\vec{x})\) finden mit möglichst geringem Fehler \(|f(\vec{x})-y|\) bei Anwendung auf den Testdaten. Dabei besteht die Gefahr von Overfitting, nämlich dass wir den Schätzer zu gut an die Besonderheiten in den verwendeten Trainingsdaten anpassen und gleichzeitig die Prognosequalität bei Anwendung auf neue unbekannte Eingabewerte sinkt (schlechte Veralgemeinerung). Um diesen Interessenskonflikt zu lösen, führt man in der später durchgeführten \(\epsilon\)-Regression einen Toleranzbereich \(\epsilon\) ein, innerhalb dessen wir Abweichungen nicht bestrafen. Mathematisch ausgedrückt gilt für die Loss-Funktion \(L_\epsilon=0\) für \(|f(\vec{x})-y|\le\epsilon\).

Als freie Parameter haben wir also \(C\) (“cost”) und \(\epsilon\), die es zu optimieren gilt. Dafür verwenden wir später eine Funktion zum Tuning der Hyperparameter. Daneben haben wir in unserem rbf-Kernel noch den Parameter \(\gamma\), der üblicherweise als Kehrwert der Anzahl der Eingabeparameter festgelegt wird.

Die SVM-Funktionalitäten sind im R-Paket “e1071” implementiert.

8.2 Datenaufbereitung

Wir arbeiten mit dem vollständigen Datensatz df_voll. Dieser enthält im Zeitraum 01.07.2013 bis 31.07.2019 eine Zeile für jedes Datum und jede Warengruppe. In den Rohdaten fehlende Umsätze sind auf Basis der Vorwochenwerte ergänzt worden. Die Zeilen mit ergänzten Umsätzen sind selektierbar über die Variable Umsatz_NA (= TRUE).

Für unser Vorhaben beschränken wir uns auf die in den Rohdaten vorhandenen Umsätze (Umsatz_NA = FALSE). Und wir schränken die Trainingsdaten später auf den Zeitraum 2015 bis 2017 ein, weil wir oben gesehen hatten, dass die Umsätze in 2014 systematisch höher liegen als in den folgenden Jahren. Die Umsätze des Jahres 2018 dienen uns dann als Testdaten.

Wir erstellen für diesen Abschnitt einen Analysedatensatz df_SVM auf Basis von df_voll. Redundante Spalten nehmen wir raus (Wochentag, Monat, Jahreszeit) und entfernen die nicht benötigten Umsatz-Spalten (Umsatz_NA sowie die Umsatz_lag Variablen).

Wir eleminieren nun fehlende Werte, dummyfizieren Wochentag_c und Monat_c (wobei wir im Gegensatz zur linearen Regression alle Wochentage und alle Monate behalten) und skalieren die Variablen Temperatur, Bewoelkung und Windgeschwindigkeit auf Werte im Bereich zwischen 0 und 1. Danach werden die alten Variablen Wochentag_c und Monat_c entfernt.

## [1]   23.11 1869.94
## [1] -6.1 32.7
## [1] 0 8
## [1]  3 35

Für die Trainingsdaten verwenden wir den Zeitraum 2015 bis 2017 und für die Testdaten das Jahr 2018. Die Modellierung erfolgt je Warengruppe, daher teilen wir den Datensatz df_SVM auf.

Wir müssen dann noch die Trainings- und Testdaten aufteilen: Für die Erstellung der Inputdaten eliminieren wir die ersten vier Spalten, also Datum, Umsatz, Warengruppe und Jahr. Und die Targetvariable ist stets der Umsatz. Zunächst arbeiten wir mit ALLEN Inputvariablen.

8.3 Modelparameter

Wir wollen im folgenden eine Regression mithilfe von SVM durchführen und verwenden dafür einen radial basis kernel. Die einzelnen Schritte führen wir zunächst für Warengruppe 1 im Detail durch und anschließend für die übrigen Warengruppen.

Warengruppe 1

## 
## Call:
## svm.default(x = df_SVM_train_WG1_input, y = df_SVM_train_WG1_target)
## 
## 
## Parameters:
##    SVM-Type:  eps-regression 
##  SVM-Kernel:  radial 
##        cost:  1 
##       gamma:  0.02380952 
##     epsilon:  0.1 
## 
## 
## Number of Support Vectors:  926

Für einen schnellen Überblick zeigen wir die echten Umsätze (schwarze Punkte) zusammen mit den prognostizierten Umsätzen (blaue Kreuze) für die Trainingsdaten. Die echten Umsätze sind hier auf der Diagonalen dargestellt, die Schätzwerte schwanken darum:

Zeige die echten Umsätze (schwarze Punkte) zusammen mit den prognostizierten Umsätzen (blaue Kreuze) für die Testdaten:

Die Modellparameter sind vorbelegt mit epsilon=0.1 und cost=1 (C). Gamma erhält als Startwert den Kehrwert der Anzahl der Inputparameter. Wir wollen nun epsilon und C optimieren, um die Modellergebnisse zu verbessern. Dafür verwenden wir eine Rasteranalyse und variieren beide Parameter (grid search). Anschließend verwenden wir das gefundene Optimum:

Jetzt wenden wir das optimierte Modell nochmal auf die Trainings- und Testinputs an:

Zeige die echten Umsätze (schwarze Punkte) zusammen mit den einfach prognostizierten Umsätzen (blaue Kreuze) und zusätzlich die Umsatzschätzung auf Basis des optimierten Modells (rote Kreuze) für die Trainingsdaten:

Zeige die echten Umsätze (schwarze Punkte) zusammen mit den einfach prognostizierten Umsätzen (blaue Kreuze) und zusätzlich die Umsatzschätzung auf Basis des optimierten Modells (rote Kreuze) für die Testsdaten:

Die Optimierung des Modells hat offenbar Erfolg: Besonders für die hohen Umsätze in der rechten Hälfte liegt der optimierte Schätzer (rote Kreuze) dichter am tatsächlichen Umsatz.

übrige Warengruppen

Die Modellparameter sind vorbelegt mit epsilon=0.1 und Cost=1 (C). Gamma erhält als Startwert den Kehrwert der Anzahl der Inputparameter. Wir wollen nun epsilon und C optimieren. Dafür verwenden wir wieder eine Rasteranalyse und variieren beide Parameter (grid search). Anschließend verwenden wir das gefundene Optimum:

# Die Rastersuche nach dem Optimum dauert einige Minuten, daher auskommentiert.
# model_SVM_WG2_tuned_grid <- tune(svm, df_SVM_train_WG2_input, df_SVM_train_WG2_target, ranges = list(epsilon = seq(0,1,0.1), cost = 2^(2:9)))
# model_SVM_WG3_tuned_grid <- tune(svm, df_SVM_train_WG3_input, df_SVM_train_WG3_target, ranges = list(epsilon = seq(0,1,0.1), cost = 2^(2:9)))
# model_SVM_WG4_tuned_grid <- tune(svm, df_SVM_train_WG4_input, df_SVM_train_WG4_target, ranges = list(epsilon = seq(0,1,0.1), cost = 2^(2:9)))
# model_SVM_WG5_tuned_grid <- tune(svm, df_SVM_train_WG5_input, df_SVM_train_WG5_target, ranges = list(epsilon = seq(0,1,0.1), cost = 2^(2:9)))

# Verwende das beste Modell (auskommentiert)
# model_SVM_WG2_tuned <- model_SVM_WG2_tuned_grid$best.model
# model_SVM_WG3_tuned <- model_SVM_WG3_tuned_grid$best.model
# model_SVM_WG4_tuned <- model_SVM_WG4_tuned_grid$best.model
# model_SVM_WG5_tuned <- model_SVM_WG5_tuned_grid$best.model
# summary(model_SVM_WG2_tuned) # cost = 4, epsilon = 0.2
# summary(model_SVM_WG3_tuned) # cost = 4, epsilon = 0.4
# summary(model_SVM_WG4_tuned) # cost = 4, epsilon = 0.8
# summary(model_SVM_WG5_tuned) # cost = 16, epsilon = 0.2

# Zur Zeitersparnis verwende nur die gefundenen optimalen Parameter: cost = 4, epsilon = 0.5
model_SVM_WG2_tuned <- svm(df_SVM_train_WG2_input, df_SVM_train_WG2_target, cost=4, epsilon=0.2)
model_SVM_WG3_tuned <- svm(df_SVM_train_WG3_input, df_SVM_train_WG3_target, cost=4, epsilon=0.4)
model_SVM_WG4_tuned <- svm(df_SVM_train_WG4_input, df_SVM_train_WG4_target, cost=4, epsilon=0.8)
model_SVM_WG5_tuned <- svm(df_SVM_train_WG5_input, df_SVM_train_WG5_target, cost=16, epsilon=0.2)

Jetzt wenden wir die optimierten Modelle auf die Trainings- und Testinputs an:

Zeige die echten Umsätze (schwarze Punkte) zusammen mit der Umsatzschätzung auf Basis des optimierten Modells (rote Kreuze) für die Trainingsdaten:

Zeige die echten Umsätze (schwarze Punkte) zusammen mit der Umsatzschätzung auf Basis des optimierten Modells (rote Kreuze) für die Testsdaten:

Den Plot für Warengruppe 5 machen wir nochmal hübsch, damit wir ihn in die Folien-Präsentation einbetten können:

8.4 Modellergebnisse

Zunächst wandeln wir die Umsatzschätzer in einen dataframe um und benennen die Spalte entsprechend:

Dann fügen wir die Umsatzschätzer an die Testdaten an und erstellen eine gemeinsame Übersichtstabelle für die Gütekennzahlen prog_SVM_vgl_kennz:

# WG1
df_SVM_test_WG1 <- cbind(df_SVM_test_WG1, SVM_test_WG1_pred_tuned)

# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
df_SVM_test_WG1 <- df_SVM_test_WG1 %>%
  mutate(Prognose_zuhoch = (Umsatz_WG1 >= Umsatz)) %>%
  mutate(Abweichung = Umsatz_WG1 - Umsatz) %>%
  mutate(Abweichung_abs = abs(Umsatz_WG1 - Umsatz)) %>%
  mutate(Abweichung_rel = (Umsatz_WG1 - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Ergänze die benötigten Hilfsgrößen
df_SVM_test_WG1 <-  df_SVM_test_WG1 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- df_SVM_test_WG1 %>%
  group_by() %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "WG1")

# füge die Kennzahlen nun an die Vergleichstabelle
prog_SVM_vgl_kennz <- temp


# WG2
df_SVM_test_WG2 <- cbind(df_SVM_test_WG2, SVM_test_WG2_pred_tuned)

# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
df_SVM_test_WG2 <- df_SVM_test_WG2 %>%
  mutate(Prognose_zuhoch = (Umsatz_WG2 >= Umsatz)) %>%
  mutate(Abweichung = Umsatz_WG2 - Umsatz) %>%
  mutate(Abweichung_abs = abs(Umsatz_WG2 - Umsatz)) %>%
  mutate(Abweichung_rel = (Umsatz_WG2 - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Ergänze die benötigten Hilfsgrößen
df_SVM_test_WG2 <-  df_SVM_test_WG2 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- df_SVM_test_WG2 %>%
  group_by() %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "WG2")

# füge die Kennzahlen nun an die Vergleichstabelle
prog_SVM_vgl_kennz <- rbind(prog_SVM_vgl_kennz, temp)


# WG3
df_SVM_test_WG3 <- cbind(df_SVM_test_WG3, SVM_test_WG3_pred_tuned)

# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
df_SVM_test_WG3 <- df_SVM_test_WG3 %>%
  mutate(Prognose_zuhoch = (Umsatz_WG3 >= Umsatz)) %>%
  mutate(Abweichung = Umsatz_WG3 - Umsatz) %>%
  mutate(Abweichung_abs = abs(Umsatz_WG3 - Umsatz)) %>%
  mutate(Abweichung_rel = (Umsatz_WG3 - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Ergänze die benötigten Hilfsgrößen
df_SVM_test_WG3 <-  df_SVM_test_WG3 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- df_SVM_test_WG3 %>%
  group_by() %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "WG3")

# füge die Kennzahlen nun an die Vergleichstabelle
prog_SVM_vgl_kennz <- rbind(prog_SVM_vgl_kennz, temp)


# WG4
df_SVM_test_WG4 <- cbind(df_SVM_test_WG4, SVM_test_WG4_pred_tuned)

# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
df_SVM_test_WG4 <- df_SVM_test_WG4 %>%
  mutate(Prognose_zuhoch = (Umsatz_WG4 >= Umsatz)) %>%
  mutate(Abweichung = Umsatz_WG4 - Umsatz) %>%
  mutate(Abweichung_abs = abs(Umsatz_WG4 - Umsatz)) %>%
  mutate(Abweichung_rel = (Umsatz_WG4 - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Ergänze die benötigten Hilfsgrößen
df_SVM_test_WG4 <-  df_SVM_test_WG4 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- df_SVM_test_WG4 %>%
  group_by() %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "WG4")

# füge die Kennzahlen nun an die Vergleichstabelle
prog_SVM_vgl_kennz <- rbind(prog_SVM_vgl_kennz, temp)


# WG5
df_SVM_test_WG5 <- cbind(df_SVM_test_WG5, SVM_test_WG5_pred_tuned)

# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
df_SVM_test_WG5 <- df_SVM_test_WG5 %>%
  mutate(Prognose_zuhoch = (Umsatz_WG5 >= Umsatz)) %>%
  mutate(Abweichung = Umsatz_WG5 - Umsatz) %>%
  mutate(Abweichung_abs = abs(Umsatz_WG5 - Umsatz)) %>%
  mutate(Abweichung_rel = (Umsatz_WG5 - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Ergänze die benötigten Hilfsgrößen
df_SVM_test_WG5 <-  df_SVM_test_WG5 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- df_SVM_test_WG5 %>%
  group_by() %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "WG5")

# füge die Kennzahlen nun an die Vergleichstabelle
prog_SVM_vgl_kennz <- rbind(prog_SVM_vgl_kennz, temp)

prog_SVM_vgl_kennz
## # A tibble: 5 x 11
##   Anzahl Umsatz_ges Umsatz_mittel   MAE   MPE  MAPE  WAPE   MSE  RMSE rRMSE
##    <int>      <dbl>         <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1    346      45738           132    25    -6    19    19  1193    35    27
## 2    346     130413           377    42     2    12    11  3015    55    15
## 3    346      59316           171    32    -7    18    18  1762    42    25
## 4    345      28354            82    19    14    25    23   584    24    29
## 5    346      93912           271    43     0    16    16  3176    56    21
## # ... with 1 more variable: Modell <chr>

Nun wollen wir und noch die Verteilung der relativen Abweichungen der Umsatzschätzung vom tatsächlichen Umsatz angucken und erstellen dafür eine weitere Vergleichstabelle prog_SVM_vgl_relAbw. Diese müssen wir dann noch pivotisieren (pivot_longer) als Vorbereitung auf den Boxplot:

# füge die relativen Abweichungen für WG1 an und benenne die Spalte um
prog_SVM_vgl_relAbw <- df_SVM_test_WG1 %>% dplyr::select(Datum, Abweichung_rel)
colnames(prog_SVM_vgl_relAbw)[2]="WG1"

# füge die relativen Abweichungen für WG2 an und benenne die Spalte um
prog_SVM_vgl_relAbw <- left_join(prog_SVM_vgl_relAbw, df_SVM_test_WG2 %>% dplyr::select(Datum, Abweichung_rel),by="Datum")
colnames(prog_SVM_vgl_relAbw)[3]="WG2"

# füge die relativen Abweichungen für WG3 an und benenne die Spalte um
prog_SVM_vgl_relAbw <- left_join(prog_SVM_vgl_relAbw, df_SVM_test_WG3 %>% dplyr::select(Datum, Abweichung_rel),by="Datum")
colnames(prog_SVM_vgl_relAbw)[4]="WG3"

# füge die relativen Abweichungen für WG4 an und benenne die Spalte um
prog_SVM_vgl_relAbw <- left_join(prog_SVM_vgl_relAbw, df_SVM_test_WG4 %>% dplyr::select(Datum, Abweichung_rel),by="Datum")
colnames(prog_SVM_vgl_relAbw)[5]="WG4"

# füge die relativen Abweichungen für WG5 an und benenne die Spalte um
prog_SVM_vgl_relAbw <- left_join(prog_SVM_vgl_relAbw, df_SVM_test_WG5 %>% dplyr::select(Datum, Abweichung_rel),by="Datum")
colnames(prog_SVM_vgl_relAbw)[6]="WG5"

# pivotisieren
prog_SVM_vgl_relAbw <- prog_SVM_vgl_relAbw %>% 
  pivot_longer(cols=-c("Datum"), names_to="Modell", values_to="Abweichung_rel")

# Boxplot
prog_SVM_vgl_relAbw %>%
  ggplot(mapping=aes(x=Modell, y=Abweichung_rel*100)) +
  geom_boxplot() + coord_flip() +
  ggtitle("2018 - Vergleich SVM Modell 1: Relative Abweichung") +
  xlab("Modell_Warengruppe") + 
  ylab("rel. Abweichung (%)") +
  ylim(-100, 200)
## Warning: Removed 2 rows containing non-finite values (stat_boxplot).

8.5 Fazit SVM-Modell

Unser SVM-Modell liefert sehr gute Schätzwerte für die Warengruppen 2 (= Brötchen) und 5 (= Kuchen). Und zwar liegt die mittlere relative Abweichung fast bei Null und der WAPE ist vergleichbar zum besten naiven und linearen Modell.

Auf der anderen Seite fällt auf, dass mit unserem SVM-Modell die Umsätze der Warengruppe 4 (= Konditorei) nur mangelhaft geschätzt werden: Der WAPE liegt relativ hoch und vor allem die mittlere relative Abweichung ist mit 14% deutlich entfernt von Null. Die Umsätze werden also systematisch stark zu hoch geschätzt.

Wir untersuchen nun, ob wir mit Deep Learning Methoden noch bessere Ergebnisse erzielen können.

9 Anwendung von DL Verfahren: Multilayer Perceptron (MLP)

9.1 Vorhaben und Theorie

Wir wollen in diesem Abschnitt ein Verfahren aus dem Bereich Deep Learning (DL) testen. Genauer gesagt wollen wir ein künstliches neuronales Netz (kNN) in Form eines einfach Multilayer Perceptrons aufbauen. Ein Perpeptron bezeichnet dabei die Grundeinheit (unit) unseres Netzes und ist eine vereinfachte künstliche Nervenzelle.

Die Abbildung zeigt ein solches Perceptron mit zwei Eingabewerten \(x_1\) und \(x_2\), sowie Gewichten \(w_1\), \(w_2\) und einer Schwelle \(\theta\). Der Ausgabewert \(y\) ergibt sich durch Anwendung einer sogenannten Aktivierungsfunktion \(f(.)\) auf die Summe der gewichteten Eingabewerte abzüglich Schwellwert. Dabei wird häufig \(b=-\theta\) gesetzt: \(y=f(h)=f(\vec{x}\cdot\vec{w}+b)\), wobei mit \(h\) das postsynaptische Potential bezeichnet wird. Beispiele für Aktivierungsfunktionen sind die Heaviside-Stufenfunktion, einfache lineare Funktionen \(f(h)=h\), gerichtete lineare Funktionen (“relu” = rectified linear units) \(f(h)=max(h,0)\) oder sigmoide Funktionen \(f(h)=\frac{1}{1+e^{-h}}\).

Mehrere Perceptrons bilden eine Schicht eines neuronalen Netzes. Und ein Netz besteht in der Regel aus einer Eingabeschicht (input layer), einer Ausgabeschicht (output layer) und optional Zwischenschichten (hidden layers), wie im Bild skizziert:

Wir haben in dieser Arbeit nur sogenannte Feedforward-Netze benutzt, bei denen die Signalrichtung immer nur von einer zur nächsten Schicht zeigt. Im Grundzustand ist jede Einheit einer Schicht mit jeder Einheit der nächsten Schicht verbunden und die Verbindung erhält ein Gewicht \(w\).

Für eine Kombination von Eingabewerten lässt sich der Ausgabewert in einem Feedforward-Netz sehr einfach berechnen. In unserem Fall haben wir eine Reihe von Trainingsdaten und kennen für gewisse Eingabeparameter die gewünschten Ausgabewerte, nämlich Umsätze je Warengruppe. In der Trainingsphase berechnen wir den Fehler (die sogenannte “Loss”-Funktion) \(L\) aus der Differenz des berechneten Ausgabewertes zum erwarteten Umsatz.

Um den Fehler zu minimieren, müssen die Gewichte und Schwellwerte rückwirkend angepasst werden, man spricht hierbei von “backpropagation”, weil man nur die Schichten bis zurück zur Eingabeschicht durchwandert. Die nötige Anpassung der Gewichte und Schwellwerte berehnet man bspw. mithilfe des Gradienten der Loss-Funktionen in Bezug auf die postsynaptischen Potentiale. Ein Standard-Verfahren ist das Gradient-Descent-Verfahren. Werden zusätzlich die Gewichte und Schwellwerte mit zufälligen Werten initialisiert, spricht man vom Stochastic-Gradient-Descent-Verfahren (SGD). Bei diesem iterativen Lernalgorithmus versucht man den Fehler zu minimieren und sich so schrittweise an ein lokales oder sogar an das globale Minimum anzunähern. Neben SGD gibt es zahlreiche weitere Optimierungsstrategien.

Eine Erweiterung des klassischen SGD-Verfahrens ist “Adam”: Dabei wird nicht nur der aktuelle Gradient für die Anpassung der Gewichte und Schwellwerte herangezogen, sondern eine Sequenz von Gradienten. Wenn mehrere aufeinanderfolgende Anpassungen in die gleiche Richtung vorgenommen werden, erhöht sich somit die Lerngeschwindigkeit, man spricht von Lernen mit Momentum. Für klassisches SGD hingegen ist die Lernrate konstant.

Ein Modell wird üblicherweise über viele Epochen trainiert. In jeder Epoche kommt jeder Trainings-Input zum Einsatz. Die Anpassung der Gewichte und Schwellwerte kann nach jedem Input vorgenommen werden (“online learning”) oder erst am Ende einer Epoche, nachdem alle Ausgabewerte für alle Eingabekombinationen berechnet wurden (“batch learning”). In der Praxis verwendet man als Kompromiss häufig sogenannte mini-batches und verwendet dabei eine gewisse Anzahl an Trainings-Inputs, bevor die Gewichte und Schwellwerte angepasst werden.

Wir haben unsere neuronalen Netze in Python programmiert. Dabei verwenden wir das von Google entwickelte open-source Framework Tensonflow, das für die datenstromorientierte Programmierung konzipiert wurde und im Bereich Deep Learning weit verbreitet ist. Darüberhinaus verwenden wir Keras als open-source Deep-Learning-Bibliothek. Unser Quellcode befindet sich im Python-Skript MLP.py.

9.2 Datenaufbereitung

Wir arbeiten mit dem vollständigen Datensatz df_voll. Dieser enthält im Zeitraum 01.07.2013 bis 31.07.2019 eine Zeile für jedes Datum und jede Warengruppe. In den Rohdaten fehlende Umsätze sind auf Basis der Vorwochenwerte ergänzt worden. Die Zeilen mit ergänzten Umsätzen sind selektierbar über die Variable Umsatz_NA (= TRUE).

Für unser Vorhaben beschränken wir uns auf die in den Rohdaten vorhandenen Umsätze (Umsatz_NA = FALSE). Und wir schränken die Trainingsdaten später auf den Zeitraum 2015 bis 2017 ein, weil wir oben gesehen hatten, dass die Umsätze in 2014 systematisch höher liegen als in den folgenden Jahren. Die Umsätze des Jahres 2018 dienen uns dann als Testdaten.

Wir erstellen für diesen Abschnitt einen Analysedatensatz df_MLP auf Basis von df_voll.

Im ersten Schritt verzichten wir auf die Variablen Windgeschwindigkeit und Bewölkung: Wir hatten nämlich in unserer Korrelationsanalyse gesehen, dass die Windgeschwindigkeit allenfalls einen sehr geringen Einfluss hat. Und die Bewölkung würde weitere 8 Dummyvariablen erfordern als Eingabe für unser MLP, daher verzichten wir darauf, um unser Modell nicht zu sehr aufzublähen.

Die Variablen Wochentag_c und Monat_c müssen nun noch dummyfiziert werden: Wir bilden für jeden Wochentag eine Variable mit Ausprägung 0/1. Und entfernen danach die alten Variablen Wochentag_c und Monat_c.

Als nächstes wollen wir noch die Temperatur-Variable dummyfizieren, indem wir sie in eine Binärvariable für 4 Intervallbereiche umwandeln. Hintergrund ist, dass die übrigen Input-Variablen bereits Binärvariablen sind und wir damit ein einheitliches Vorgehen für die Befütterung unseres kNN erreichen. Wir wählen die Intervalle und Bezeichnungen wie folgt:

  • Temp_eis: < 0 Grad
  • Temp_kalt: [0 bis 10 Grad)
  • Temp_warm: [10 bis 20 Grad)
  • Temp_heiss: >= 20 Grad

Wir wandeln noch das Datum in eine Integerzahl um, weil wir sonst Probleme beim Import nach Python bekommen.

Für die Trainingsdaten verwenden wir den Zeitraum 2015 bis 2017 und für die Testdaten das Jahr 2018. Die Modellierung erfolgt je Warengruppe, daher teilen wir den Datensatz df_MLP auf.

Das MLP wird in Python aufgebaut, daher exportieren wir die Trainings- und Testdatensätze für die verschiedenen Warengruppen als .csv. Wir verzichten beim Export auf die Zeilenüberschriften.

9.3 Modellparameter

Modell 1 (MLP_mod1)

Im ersten Versuch bauen wir ein vergleichsweise kleines Modell und behalten nur die Variablen für SommerferienSH, Feiertag und Wochentage (Mo - So) als binäre Inputvariablen. Anders als bei der linearen Regression verwenden wir alle Wochentage. Wir haben also insgesamt 9 binäre Inputvariablen. Als output wollen wir den Umsatzschätzer erhalten und brauchen dafür im output layer nur eine Unit mit linearer Aktivierungsfunktion. Der Umsatz soll jedoch positiv sein, also verwenden wir eine “rectified linear unit” (relu).

Dazwischen liegt noch ein hidden layer mit 20 Units, hier verwenden wir die sigmoide Aktivierungsfunktion (sigmoid). Die Verwendung von mehr Einheiten im hidden layer brachte keine besseren Ergebnisse.

Als loss-Funktion verwenden wir standardmäßig den mean squared error (mse). Daneben verwenden wir stochastic gradient descent (SGD) als iterativen Lernalgorithmus mit einer Lernrate von 0.01. Auch hier brachte eine höhere oder niedrigere Lernrate keine besseren Ergebnisse.

Die Gewichte und Schwellwerte werden mit kleinen zufälligen Werten initialisiert unter Anwendung der Standard-Normalverteilung. Wir trainieren das einfache Modell über 50 Epochen, weil wir festgestellt haben, dass nach etwa 40 Epochen die loss-Parameter stabil bleiben. Und die batch-Größe setzen wir auf 10.

Modell 2 (MLP_mod2)

Im zweiten Schritt erweitern wir unser Modell und verwenden noch KielerWoche, Temperatur, Silvester_ext und Monat als Inputvariablen. Monat_c wurde dafür dummyfiziert. Und die Temperatur ist in 4 Bereiche und damit 4 Binärvariablen umgewandelt worden, damit wir einheitlich nur Binär-Inputs verwenden.

Insgesamt haben wir 27 Inputvariablen und erhöhen die Anzahl der Neuronen im hidden layer von 20 auf 50. Eine weitere Erhöhung liefert keine signifikant besseren Ergebnisse.

Im Training verwenden wir diesmal 100 Epochen, weil das komplexere Modell erst nach ca. 80 Epochen stabile loss-Werte zeigt.

9.4 Ergebnisse

Modell 1 (MLP_mod1)

Wir haben je ein Modell pro Warengruppe trainiert. Python liefert uns folgende finalen Parameter als train error:

Modell MSE MAE
mod1_WG1 916 21.8
mod1_WG2 6489 64.0
mod1_WG3 2012 35.5
mod1_WG4 845 20.2
mod1_WG5 6891 44.8

Wenn wir in Python die trainierten Modelle auf die Testdaten anwenden, erhalten wir Umsatzschätzer je Warengruppe, die wir als csv hier einladen.

Füge die Ergebnisse an die Test-Daten (für jede Warengruppe) und erstelle dann eine gemeinsame Übersichtstabelle für die Gütekennzahlen prog_MLP_vgl_kennz:

# mod1_WG1
df_MLP_test_mod1_WG1 <- cbind(df_MLP_test_WG1, df_MLP_test_mod1_WG1_pred)

# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
df_MLP_test_mod1_WG1 <- df_MLP_test_mod1_WG1 %>%
  mutate(Prognose_zuhoch = (Umsatz_mod1_WG1 >= Umsatz)) %>%
  mutate(Abweichung = Umsatz_mod1_WG1 - Umsatz) %>%
  mutate(Abweichung_abs = abs(Umsatz_mod1_WG1 - Umsatz)) %>%
  mutate(Abweichung_rel = (Umsatz_mod1_WG1 - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Ergänze die benötigten Hilfsgrößen
df_MLP_test_mod1_WG1 <-  df_MLP_test_mod1_WG1 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- df_MLP_test_mod1_WG1 %>%
  group_by() %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "mod1_WG1")

# füge die Kennzahlen nun an die Vergleichstabelle
prog_MLP_vgl_kennz <- temp


# mod1_WG2
df_MLP_test_mod1_WG2 <- cbind(df_MLP_test_WG2, df_MLP_test_mod1_WG2_pred)

# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
df_MLP_test_mod1_WG2 <- df_MLP_test_mod1_WG2 %>%
  mutate(Prognose_zuhoch = (Umsatz_mod1_WG2 >= Umsatz)) %>%
  mutate(Abweichung = Umsatz_mod1_WG2 - Umsatz) %>%
  mutate(Abweichung_abs = abs(Umsatz_mod1_WG2 - Umsatz)) %>%
  mutate(Abweichung_rel = (Umsatz_mod1_WG2 - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Ergänze die benötigten Hilfsgrößen
df_MLP_test_mod1_WG2 <-  df_MLP_test_mod1_WG2 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- df_MLP_test_mod1_WG2 %>%
  group_by() %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "mod1_WG2")

# füge die Kennzahlen nun an die Vergleichstabelle
prog_MLP_vgl_kennz <- rbind(prog_MLP_vgl_kennz, temp)


# mod1_WG3
df_MLP_test_mod1_WG3 <- cbind(df_MLP_test_WG3, df_MLP_test_mod1_WG3_pred)

# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
df_MLP_test_mod1_WG3 <- df_MLP_test_mod1_WG3 %>%
  mutate(Prognose_zuhoch = (Umsatz_mod1_WG3 >= Umsatz)) %>%
  mutate(Abweichung = Umsatz_mod1_WG3 - Umsatz) %>%
  mutate(Abweichung_abs = abs(Umsatz_mod1_WG3 - Umsatz)) %>%
  mutate(Abweichung_rel = (Umsatz_mod1_WG3 - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Ergänze die benötigten Hilfsgrößen
df_MLP_test_mod1_WG3 <-  df_MLP_test_mod1_WG3 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- df_MLP_test_mod1_WG3 %>%
  group_by() %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "mod1_WG3")

# füge die Kennzahlen nun an die Vergleichstabelle
prog_MLP_vgl_kennz <- rbind(prog_MLP_vgl_kennz, temp)


# mod1_WG4
df_MLP_test_mod1_WG4 <- cbind(df_MLP_test_WG4, df_MLP_test_mod1_WG4_pred)

# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
df_MLP_test_mod1_WG4 <- df_MLP_test_mod1_WG4 %>%
  mutate(Prognose_zuhoch = (Umsatz_mod1_WG4 >= Umsatz)) %>%
  mutate(Abweichung = Umsatz_mod1_WG4 - Umsatz) %>%
  mutate(Abweichung_abs = abs(Umsatz_mod1_WG4 - Umsatz)) %>%
  mutate(Abweichung_rel = (Umsatz_mod1_WG4 - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Ergänze die benötigten Hilfsgrößen
df_MLP_test_mod1_WG4 <-  df_MLP_test_mod1_WG4 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- df_MLP_test_mod1_WG4 %>%
  group_by() %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "mod1_WG4")

# füge die Kennzahlen nun an die Vergleichstabelle
prog_MLP_vgl_kennz <- rbind(prog_MLP_vgl_kennz, temp)


# mod1_WG5
df_MLP_test_mod1_WG5 <- cbind(df_MLP_test_WG5, df_MLP_test_mod1_WG5_pred)

# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
df_MLP_test_mod1_WG5 <- df_MLP_test_mod1_WG5 %>%
  mutate(Prognose_zuhoch = (Umsatz_mod1_WG5 >= Umsatz)) %>%
  mutate(Abweichung = Umsatz_mod1_WG5 - Umsatz) %>%
  mutate(Abweichung_abs = abs(Umsatz_mod1_WG5 - Umsatz)) %>%
  mutate(Abweichung_rel = (Umsatz_mod1_WG5 - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Ergänze die benötigten Hilfsgrößen
df_MLP_test_mod1_WG5 <-  df_MLP_test_mod1_WG5 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- df_MLP_test_mod1_WG5 %>%
  group_by() %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "mod1_WG5")

# füge die Kennzahlen nun an die Vergleichstabelle
prog_MLP_vgl_kennz <- rbind(prog_MLP_vgl_kennz, temp)

prog_MLP_vgl_kennz
## # A tibble: 5 x 11
##   Anzahl Umsatz_ges Umsatz_mittel   MAE   MPE  MAPE  WAPE   MSE  RMSE rRMSE
##    <int>      <dbl>         <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1    346      45738           132    26    -4    20    20  1422    38    29
## 2    346     130413           377    70     4    20    19  6733    82    22
## 3    346      59316           171    41     3    26    24  2694    52    30
## 4    345      28354            82    19    17    26    23   604    25    30
## 5    346      93912           271    63    19    25    23  9873    99    37
## # ... with 1 more variable: Modell <chr>

Das einfache Modell (mod1), das für die Umsatzschätzung nur SommerferienSH, Feiertag und Wochentage (Mo - So) als Inputvariablen einbezieht, liefert unterschiedliche Ergebnisse für die verschiedenen Warengruppen: Zunächst fällt auf, dass die mittlere relative Abweichung (MPE) für die Warengruppen 1, 2 und 3 nahe Null ist, während wir für die beiden Warengruppen 4 und 5 offenbar den Umsatz systematisch zu hoch schätzen.

Der gewichtete mittlere Absolutwert der relativen Abweichung (WAPE) zeigt für die Warengruppe 2 den niedrigsten Fehler. Wir hatten jedoch für das beste naive und lineare Schätzmodell einen deutlich niedrigeren Fehler gesehen für Warengruppe 2 (WAPE = 11). Und auch unser SVM-Modell lag für die Warengruppe in der Größenordnung.

Trotzdem wollen wir uns die Verteilung der relativen Abweichungen der Umsatzschätzung vom tatsächlichen Umsatz angucken und erstellen dafür eine weitere Vergleichstabelle prog_MLP_vgl_relAbw. Diese müssen wir dann noch pivotisieren (pivot_longer) als Vorbereitung auf den Boxplot:

# füge die relativen Abweichungen für WG1 an und benenne die Spalte um
prog_MLP_vgl_relAbw <- df_MLP_test_mod1_WG1 %>% dplyr::select(Datum, Abweichung_rel)
colnames(prog_MLP_vgl_relAbw)[2]="mod1_WG1"

# füge die relativen Abweichungen für WG2 an und benenne die Spalte um
prog_MLP_vgl_relAbw <- left_join(prog_MLP_vgl_relAbw, df_MLP_test_mod1_WG2 %>% dplyr::select(Datum, Abweichung_rel),by="Datum")
colnames(prog_MLP_vgl_relAbw)[3]="mod1_WG2"

# füge die relativen Abweichungen für WG3 an und benenne die Spalte um
prog_MLP_vgl_relAbw <- left_join(prog_MLP_vgl_relAbw, df_MLP_test_mod1_WG3 %>% dplyr::select(Datum, Abweichung_rel),by="Datum")
colnames(prog_MLP_vgl_relAbw)[4]="mod1_WG3"

# füge die relativen Abweichungen für WG4 an und benenne die Spalte um
prog_MLP_vgl_relAbw <- left_join(prog_MLP_vgl_relAbw, df_MLP_test_mod1_WG4 %>% dplyr::select(Datum, Abweichung_rel),by="Datum")
colnames(prog_MLP_vgl_relAbw)[5]="mod1_WG4"

# füge die relativen Abweichungen für WG5 an und benenne die Spalte um
prog_MLP_vgl_relAbw <- left_join(prog_MLP_vgl_relAbw, df_MLP_test_mod1_WG5 %>% dplyr::select(Datum, Abweichung_rel),by="Datum")
colnames(prog_MLP_vgl_relAbw)[6]="mod1_WG5"

# pivotisieren
prog_MLP_vgl_relAbw <- prog_MLP_vgl_relAbw %>% 
  pivot_longer(cols=-c("Datum"), names_to="Modell", values_to="Abweichung_rel")

# Boxplot
prog_MLP_vgl_relAbw %>%
  ggplot(mapping=aes(x=Modell, y=Abweichung_rel*100)) +
  geom_boxplot() + coord_flip() +
  ggtitle("2018 - Vergleich MLP Modell 1: Relative Abweichung") +
  xlab("Modell_Warengruppe") + 
  ylab("rel. Abweichung (%)") +
  ylim(-100, 200)
## Warning: Removed 2 rows containing non-finite values (stat_boxplot).

Modell 2 (MLP_mod2)

Im zweiten Schritt erweitern wir unser Modell und verwenden noch KielerWoche, Temperatur, Silvester_ext und Monat als Inputvariablen. Monat_c wurde dafür dummyfiziert. Und die Temperatur ist in 4 Bereiche und damit 4 Binärvariablen umgewandelt worden, damit wir einheitlich nur Binär-Inputs verwenden.

Wir haben je ein Modell pro Warengruppe trainiert. Python liefert uns folgende finalen Parameter als train error:

Modell MSE MAE
mod1_WG1 683 18.9
mod1_WG2 2731 38.7
mod1_WG3 851 21.6
mod1_WG4 528 16.7
mod1_WG5 1588 30.2

Wenn wir in Python die trainierten Modelle auf die Testdaten anwenden, erhalten wir Umsatzschätzer je Warengruppe, die wir als csv hier einladen.

Füge die Ergebnisse an die Test-Daten (für jede Warengruppe) und erstelle dann eine gemeinsame Übersichtstabelle für die Gütekennzahlen prog_MLP_vgl_kennz_mod2:

# mod2_WG1
df_MLP_test_mod2_WG1 <- cbind(df_MLP_test_WG1, df_MLP_test_mod2_WG1_pred)

# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
df_MLP_test_mod2_WG1 <- df_MLP_test_mod2_WG1 %>%
  mutate(Prognose_zuhoch = (Umsatz_mod2_WG1 >= Umsatz)) %>%
  mutate(Abweichung = Umsatz_mod2_WG1 - Umsatz) %>%
  mutate(Abweichung_abs = abs(Umsatz_mod2_WG1 - Umsatz)) %>%
  mutate(Abweichung_rel = (Umsatz_mod2_WG1 - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Ergänze die benötigten Hilfsgrößen
df_MLP_test_mod2_WG1 <-  df_MLP_test_mod2_WG1 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- df_MLP_test_mod2_WG1 %>%
  group_by() %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "mod2_WG1")

# füge die Kennzahlen nun an die Vergleichstabelle
prog_MLP_vgl_kennz_mod2 <- temp


# mod2_WG2
df_MLP_test_mod2_WG2 <- cbind(df_MLP_test_WG2, df_MLP_test_mod2_WG2_pred)

# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
df_MLP_test_mod2_WG2 <- df_MLP_test_mod2_WG2 %>%
  mutate(Prognose_zuhoch = (Umsatz_mod2_WG2 >= Umsatz)) %>%
  mutate(Abweichung = Umsatz_mod2_WG2 - Umsatz) %>%
  mutate(Abweichung_abs = abs(Umsatz_mod2_WG2 - Umsatz)) %>%
  mutate(Abweichung_rel = (Umsatz_mod2_WG2 - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Ergänze die benötigten Hilfsgrößen
df_MLP_test_mod2_WG2 <-  df_MLP_test_mod2_WG2 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- df_MLP_test_mod2_WG2 %>%
  group_by() %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "mod2_WG2")

# füge die Kennzahlen nun an die Vergleichstabelle
prog_MLP_vgl_kennz_mod2 <- rbind(prog_MLP_vgl_kennz_mod2, temp)


# mod2_WG3
df_MLP_test_mod2_WG3 <- cbind(df_MLP_test_WG3, df_MLP_test_mod2_WG3_pred)

# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
df_MLP_test_mod2_WG3 <- df_MLP_test_mod2_WG3 %>%
  mutate(Prognose_zuhoch = (Umsatz_mod2_WG3 >= Umsatz)) %>%
  mutate(Abweichung = Umsatz_mod2_WG3 - Umsatz) %>%
  mutate(Abweichung_abs = abs(Umsatz_mod2_WG3 - Umsatz)) %>%
  mutate(Abweichung_rel = (Umsatz_mod2_WG3 - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Ergänze die benötigten Hilfsgrößen
df_MLP_test_mod2_WG3 <-  df_MLP_test_mod2_WG3 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- df_MLP_test_mod2_WG3 %>%
  group_by() %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "mod2_WG3")

# füge die Kennzahlen nun an die Vergleichstabelle
prog_MLP_vgl_kennz_mod2 <- rbind(prog_MLP_vgl_kennz_mod2, temp)


# mod2_WG4
df_MLP_test_mod2_WG4 <- cbind(df_MLP_test_WG4, df_MLP_test_mod2_WG4_pred)

# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
df_MLP_test_mod2_WG4 <- df_MLP_test_mod2_WG4 %>%
  mutate(Prognose_zuhoch = (Umsatz_mod2_WG4 >= Umsatz)) %>%
  mutate(Abweichung = Umsatz_mod2_WG4 - Umsatz) %>%
  mutate(Abweichung_abs = abs(Umsatz_mod2_WG4 - Umsatz)) %>%
  mutate(Abweichung_rel = (Umsatz_mod2_WG4 - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Ergänze die benötigten Hilfsgrößen
df_MLP_test_mod2_WG4 <-  df_MLP_test_mod2_WG4 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- df_MLP_test_mod2_WG4 %>%
  group_by() %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "mod2_WG4")

# füge die Kennzahlen nun an die Vergleichstabelle
prog_MLP_vgl_kennz_mod2 <- rbind(prog_MLP_vgl_kennz_mod2, temp)


# mod2_WG5
df_MLP_test_mod2_WG5 <- cbind(df_MLP_test_WG5, df_MLP_test_mod2_WG5_pred)

# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
df_MLP_test_mod2_WG5 <- df_MLP_test_mod2_WG5 %>%
  mutate(Prognose_zuhoch = (Umsatz_mod2_WG5 >= Umsatz)) %>%
  mutate(Abweichung = Umsatz_mod2_WG5 - Umsatz) %>%
  mutate(Abweichung_abs = abs(Umsatz_mod2_WG5 - Umsatz)) %>%
  mutate(Abweichung_rel = (Umsatz_mod2_WG5 - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Ergänze die benötigten Hilfsgrößen
df_MLP_test_mod2_WG5 <-  df_MLP_test_mod2_WG5 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- df_MLP_test_mod2_WG5 %>%
  group_by() %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "mod2_WG5")

# füge die Kennzahlen nun an die Vergleichstabelle
prog_MLP_vgl_kennz_mod2 <- rbind(prog_MLP_vgl_kennz_mod2, temp)

prog_MLP_vgl_kennz_mod2
## # A tibble: 5 x 11
##   Anzahl Umsatz_ges Umsatz_mittel   MAE   MPE  MAPE  WAPE   MSE  RMSE rRMSE
##    <int>      <dbl>         <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1    346      45738           132    27    -4    21    20  1453    38    29
## 2    346     130413           377    46     7    13    12  3519    59    16
## 3    346      59316           171    34    -9    19    20  2051    45    26
## 4    345      28354            82    18     5    22    22   572    24    29
## 5    346      93912           271    43    -1    16    16  3367    58    21
## # ... with 1 more variable: Modell <chr>

Das erweiterte Modell (mod2) liefert im Gegensatz zum einfachen Modell (mod1) einheitlichere Ergebnisse für die verschiedenen Warengruppen: Zunächst fällt auf, dass die mittlere relative Abweichung (MPE) nun für die beiden Warengruppen 4 und 5 nahe Null liegt und sich unser Schätzer für die Warengruppen 2 und 3 leicht von Null entfernt haben.

Und der gewichtete mittlere Absolutwert der relativen Abweichung (WAPE) zeigt für die Warengruppen 2 und 5 die niedrigsten Fehler. Gleiches hatten wir bei den besten naiven und linearen Modellen sowie unserem SVM-Modell gefunden. Zum Vergleich: Für das beste naive Schätzmodell (glDS_4T_erw) hatten wir für Warengruppe 2 sogar einen etwas niedrigeren WAPE = 11 gesehen.

Als nächstes wollen wir uns die Verteilung der relativen Abweichungen der Umsatzschätzung vom tatsächlichen Umsatz angucken und erstellen dafür eine weitere Vergleichstabelle prog_MLP_vgl_relAbw_mod2. Diese müssen wir dann noch pivotisieren (pivot_longer) als Vorbereitung auf den Boxplot:

# füge die relativen Abweichungen für WG1 an und benenne die Spalte um
prog_MLP_vgl_relAbw_mod2 <- df_MLP_test_mod2_WG1 %>% dplyr::select(Datum, Abweichung_rel)
colnames(prog_MLP_vgl_relAbw_mod2)[2]="mod2_WG1"

# füge die relativen Abweichungen für WG2 an und benenne die Spalte um
prog_MLP_vgl_relAbw_mod2 <- left_join(prog_MLP_vgl_relAbw_mod2, df_MLP_test_mod2_WG2 %>% dplyr::select(Datum, Abweichung_rel),by="Datum")
colnames(prog_MLP_vgl_relAbw_mod2)[3]="mod2_WG2"

# füge die relativen Abweichungen für WG3 an und benenne die Spalte um
prog_MLP_vgl_relAbw_mod2 <- left_join(prog_MLP_vgl_relAbw_mod2, df_MLP_test_mod2_WG3 %>% dplyr::select(Datum, Abweichung_rel),by="Datum")
colnames(prog_MLP_vgl_relAbw_mod2)[4]="mod2_WG3"

# füge die relativen Abweichungen für WG4 an und benenne die Spalte um
prog_MLP_vgl_relAbw_mod2 <- left_join(prog_MLP_vgl_relAbw_mod2, df_MLP_test_mod2_WG4 %>% dplyr::select(Datum, Abweichung_rel),by="Datum")
colnames(prog_MLP_vgl_relAbw_mod2)[5]="mod2_WG4"

# füge die relativen Abweichungen für WG5 an und benenne die Spalte um
prog_MLP_vgl_relAbw_mod2 <- left_join(prog_MLP_vgl_relAbw_mod2, df_MLP_test_mod2_WG5 %>% dplyr::select(Datum, Abweichung_rel),by="Datum")
colnames(prog_MLP_vgl_relAbw_mod2)[6]="mod2_WG5"

# pivotisieren
prog_MLP_vgl_relAbw_mod2 <- prog_MLP_vgl_relAbw_mod2 %>% 
  pivot_longer(cols=-c("Datum"), names_to="Modell", values_to="Abweichung_rel")

# Boxplot
prog_MLP_vgl_relAbw_mod2 %>%
  ggplot(mapping=aes(x=Modell, y=Abweichung_rel*100)) +
  geom_boxplot() + coord_flip() +
  ggtitle("2018 - Vergleich MLP Modell 2: Relative Abweichung") +
  xlab("rel. Abweichung (%)") + 
  ylab("Dichte") +
  ylim(-100, 200)
## Warning: Removed 2 rows containing non-finite values (stat_boxplot).

Die Umsatzschätzung gelingt offenbar für die Warengruppe 2 (= Brötchen) ab besten.

9.5 Fazit DL Modelle

Wir haben in diesem Abschnitt zwei Multilayer Perceptron Modelle eingesetzt und genauer untersucht. Die Ergebnisse sind brauchbar aber nicht umwerfend. In beiden Modellen haben wir stochastic gradiend descent einen iterativen Lernalgorithmus verwendet, der keine Garantie gibt, das globale Optimum für die Gewichte und Schwellwerte zu finden. Das kann ein Grund für die mangelnde Ergebnis-Qualität sein.

Die Parameter - wie bspw. die Lernrate, die Anzahl der hidden layers und der Anzahl der Neuronen im hidden layer - haben wir empirisch festgelegt. Hierfür gibt es keine “optimalen Werte”.

Insgesamt stellen wir fest, dass die so gebauten MLP Modelle dem Problem nicht gerecht werden. Vermutlich würde man mit rekursiven Netzen und/oder dem Einsatz von long-short-term-memory (LSTM) Einheiten deutlich bessere Ergebnisse erzielen. Das sprengt jedoch den Umfang dieser Projektarbeit und wird daher nicht weiter betrachtet.

Wir hatten gesehen, dass das komplexe Modell (mod2) für die Warengruppe 2 in Bezug auf den WAPE gute Ergebnisse liefert. Ein Ansatz ist, das Modell gezielt für diese Warengruppe noch zu erweitern. Hier haben wir versucht, einen zweiten hidden layer mit 20 Einheiten in das Modell zu integrieren. Allerdings verschlechterten sich dadurch die Prognose-Ergebnisse, so dass wir den Ansatz nicht weiter verfolgt haben. Alternativ haben wir ein Kompromiss-Modell (mod3) getestet, das nur die Variablen SommerferienSH, Feiertag, Silvester_ext, Samstag, Sonntag, Juli und August enthält. Und dieses Modell haben wir versucht, für Warengruppe 2 zu optimieren durch Variation der Units im hidden layer, Anwendung anderer Lernalgorithmen (Adam) oder Hinzunahme eines weiteren hidden layers - ohne Erfolg.

Auch könnte man das Modell gezielt auf die Feiertags-Effekte trainieren, um dafür bessere Ergebnisse zu erzielen. Diese Idee stellt eine Ausbaustufe dar, die wir hier nicht umgesetzt haben.

Insgesamt ging es hier eher darum, Erfahrungswerte in der praktischen Anwendung von DL-Verfahren zu sammeln und das ist in der Tat sehr gut gelungen.

9.6 Zugabe

Weil wir uns vom MLP bessere Ergebnisse erhofft hatten, haben wir noch einen drauf gesetzt und noch ein viertes MLP (mod4) getestet. Dafür haben wir den vollständigen SVM-Datensatz verwendet mit allen Inputvariablen und skalierten Wettervariablen sowie skaliertem Umsatz.

Getestet haben wir wieder sequentielle MLP-Modelle, diesmal aber gezielt mit mehreren hidden layers. Die besten Ergebnisse lieferte ein Modell mit zwei hidden layers, bestehend aus 100 bzw. 50 Einheiten, jeweils mit ‘relu’ Aktivierungsfunktionen. Als Lernalgorithmus haben wir dabei ‘Adam’ angewendet mit einer Lernrate von 0.001, gleichzeitig haben wir online learning (batch_size = 1) angewendet und das Modell über 20 Epochen trainiert.

Diese Parametereinstellungen lieferten die besten Ergebnisse (df_MLP_test_mod4_WG2_pred.csv). Verlängert man die Trainingsphase um weitere 20 Epochen (df_MLP_test_mod4_WG2_pred2.csv), verschlechtert sich die Prognosegüte bei Anwendung des Modells auf die Testdaten. Ein dritter hidden layer mit 25 Einheiten (df_MLP_test_mod4_WG2_pred3.csv) bringt keinen Mehrwert. Und auch wenn man die Anzahl der Einheiten im ersten hidden layer verdoppelt (df_MLP_test_mod4_WG2_pred4.csv), erzielt man keine genaueren Schätzwerte.

Hier die Testergebnisse - exemplarisch für Warengruppe 2:

Füge die Ergebnisse an die Test-Daten und bilde die Gütekennzahlen. Vorher müssen wir den Umsatz wieder zurück skalieren:

# mod1_WG1
df_MLP_test_mod4_WG2 <- cbind(df_SVM_test_WG2, df_MLP_test_mod4_WG2_pred)

# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
df_MLP_test_mod4_WG2 <- df_MLP_test_mod4_WG2 %>%
  # mutate(Umsatz = Umsatz * 2000) %>%
  # Hinweis: Wir hatten ursprünglich den Umsatz im Kapitel SVM skaliert und auf der Basis
  # unser MLP (mod4) trainiert. Nachträglich haben wir die Skalierung für den    
  # df_SVM_test_WG2 wieder raus genommen. Dennoch enthalten die Modellergebnisse aus Python
  # den skalierten Umsatz und müssen wieder re-skaliert werden:
  mutate(Umsatz_mod4_WG2 = Umsatz_mod4_WG2 * 2000) %>%
  mutate(Prognose_zuhoch = (Umsatz_mod4_WG2 >= Umsatz)) %>%
  mutate(Abweichung = Umsatz_mod4_WG2 - Umsatz) %>%
  mutate(Abweichung_abs = abs(Umsatz_mod4_WG2 - Umsatz)) %>%
  mutate(Abweichung_rel = (Umsatz_mod4_WG2 - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Ergänze die benötigten Hilfsgrößen
df_MLP_test_mod4_WG2 <-  df_MLP_test_mod4_WG2 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
df_MLP_test_mod4_WG2 %>%
  group_by() %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))
## # A tibble: 1 x 10
##   Anzahl Umsatz_ges Umsatz_mittel   MAE   MPE  MAPE  WAPE   MSE  RMSE rRMSE
##    <int>      <dbl>         <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1    346     130413           377    39     2    11    10  2594    51    14

Der WAPE liegt bei 10 und liegt damit knapp unterhalb des besten naiven und linearen Modells, sowie des SVM-Modells. Das hat uns ermutigt, Modell 4 auf eine andere Warengruppe anzuwenden.

Hier die Ergebnisse für Warengruppe 4:

Füge die Ergebnisse an die Test-Daten und bilde die Gütekennzahlen. VORHER den Umsatz wieder zurück skalieren:

# mod1_WG1
df_MLP_test_mod4_WG4 <- cbind(df_SVM_test_WG4, df_MLP_test_mod4_WG4_pred)

# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
df_MLP_test_mod4_WG4 <- df_MLP_test_mod4_WG4 %>%
  # mutate(Umsatz = Umsatz * 2000) %>%
  # Hinweis: Wir hatten ursprünglich den Umsatz im Kapitel SVM skaliert und auf der Basis
  # unser MLP (mod4) trainiert. Nachträglich haben wir die Skalierung für den    
  # df_SVM_test_WG4 wieder raus genommen. Dennoch enthalten die Modellergebnisse aus Python
  # den skalierten Umsatz und müssen wieder re-skaliert werden:
  mutate(Umsatz_mod4_WG4 = Umsatz_mod4_WG4 * 2000) %>%
  mutate(Prognose_zuhoch = (Umsatz_mod4_WG4 >= Umsatz)) %>%
  mutate(Abweichung = Umsatz_mod4_WG4 - Umsatz) %>%
  mutate(Abweichung_abs = abs(Umsatz_mod4_WG4 - Umsatz)) %>%
  mutate(Abweichung_rel = (Umsatz_mod4_WG4 - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Ergänze die benötigten Hilfsgrößen
df_MLP_test_mod4_WG4 <-  df_MLP_test_mod4_WG4 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
df_MLP_test_mod4_WG4 %>%
  group_by() %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))
## # A tibble: 1 x 10
##   Anzahl Umsatz_ges Umsatz_mittel   MAE   MPE  MAPE  WAPE   MSE  RMSE rRMSE
##    <int>      <dbl>         <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1    345      28354            82    19    13    25    23   741    27    33

Unsere Hoffnung hat sich jedoch nicht erfüllt: Der WAPE ist schlechter als für das einfachere Modell 2 (mod2) für die Warengruppe 4.

10 Modellvergleich

Wir wollen nun eine Gesamttabelle aller Vergleichskennzahlen erstellen. Wir beschränken uns dabei auf die Anwendung der Modelle auf die Testdaten, betrachten also die Testfehler.

Wir hatten fünf verschiedene Verfahren angewendet: Naive Modelle (“naiv”), lineare Regressionsmodelle (“lm”), Entscheidungsbäume (“DT”), Support Vector Machines (“SVM”) und Multilayer Perceptrons (“MLP”).

Innerhalb der Verfahren haben wir bereits die besten Modelle identifiziert:

  • Bei den naiven Modellen lieferte der erweiterte gleitende Durchschnitt der letzten 4 Wochen- bzw. Wochenendtage (glDS_4T_erw) die besten Schätzer.
  • Für die linearen Regressionsmodelle hatten wir gesehen, dass die Modelle mit 21 (best21), 24 (best24), 30 (best30), 1 (best1) und 8 (best8) die besten Schätzer für die Warengruppen 1 bis 5 lieferten.
  • Bei den Entscheidungsbäumen (bzw. Regression trees) hatten wir für jede Warengruppe (WG1 bis WG5) ein optimales Modell berchnet.
  • Bei den Support Vector Machines hatten wir für jede Warengruppe genau ein Modell (WG1 bis WG5) optimiert.
  • Und bei den Multilayer Perceptronen hatten wir mit Modell 2 (mod2) gute Ergebnisse erzielt. Und für die Warengruppe 2 hatte unser Zugabe-Modell (mod4) die besten Ergebnisse geliefert.

Die besten Modelle werden nun für alle Warengruppen in einer Tabelle modell_vergleich_WG zusammengestellt.

# bestes naives Modell
temp <- prog_naiv_glDS_4T_erw %>%
  mutate(Verfahren="naiv") %>%
  mutate(Modell="glDS_4T_erw") %>%
  group_by(Verfahren, Modell, Warengruppe) %>%
  filter(Jahr==2018) %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# Anfügen der Ergebnisse an die Vergleichstabelle
modell_vergleich_WG <- temp

# bestes lineares Modell: WG1
temp <- df_lm_test_WG1_21 %>%
  mutate(Verfahren="lm") %>%
  mutate(Modell="best21") %>%
  mutate(Warengruppe=1) %>%
  group_by(Verfahren, Modell, Warengruppe) %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# Anfügen der Ergebnisse an die Vergleichstabelle
modell_vergleich_WG <- rbind(modell_vergleich_WG, temp) 

# bestes lineares Modell: WG2
temp <- df_lm_test_WG2_24 %>%
  mutate(Verfahren="lm") %>%
  mutate(Modell="best24") %>%
  mutate(Warengruppe=2) %>%
  group_by(Verfahren, Modell, Warengruppe) %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# Anfügen der Ergebnisse an die Vergleichstabelle
modell_vergleich_WG <- rbind(modell_vergleich_WG, temp) 

# bestes lineares Modell: WG3
temp <- df_lm_test_WG3_30 %>%
  mutate(Verfahren="lm") %>%
  mutate(Modell="best30") %>%
  mutate(Warengruppe=3) %>%
  group_by(Verfahren, Modell, Warengruppe) %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# Anfügen der Ergebnisse an die Vergleichstabelle
modell_vergleich_WG <- rbind(modell_vergleich_WG, temp) 

# bestes lineares Modell: WG4
temp <- df_lm_test_WG4_1 %>%
  mutate(Verfahren="lm") %>%
  mutate(Modell="best1") %>%
  mutate(Warengruppe=4) %>%
  group_by(Verfahren, Modell, Warengruppe) %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# Anfügen der Ergebnisse an die Vergleichstabelle
modell_vergleich_WG <- rbind(modell_vergleich_WG, temp) 

# bestes lineares Modell: WG5
temp <- df_lm_test_WG5_8 %>%
  mutate(Verfahren="lm") %>%
  mutate(Modell="best8") %>%
  mutate(Warengruppe=5) %>%
  group_by(Verfahren, Modell, Warengruppe) %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# Anfügen der Ergebnisse an die Vergleichstabelle
modell_vergleich_WG <- rbind(modell_vergleich_WG, temp) 

# bester Entscheidungsbaum: WG1
temp <- df_dt_test_WG1 %>%
  mutate(Verfahren="DT") %>%
  mutate(Modell="WG1") %>%
  mutate(Warengruppe=1) %>%
  group_by(Verfahren, Modell, Warengruppe) %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# Anfügen der Ergebnisse an die Vergleichstabelle
modell_vergleich_WG <- rbind(modell_vergleich_WG, temp)

# bester Entscheidungsbaum: WG2
temp <- df_dt_test_WG2 %>%
  mutate(Verfahren="DT") %>%
  mutate(Modell="WG2") %>%
  mutate(Warengruppe=2) %>%
  group_by(Verfahren, Modell, Warengruppe) %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# Anfügen der Ergebnisse an die Vergleichstabelle
modell_vergleich_WG <- rbind(modell_vergleich_WG, temp)

# bester Entscheidungsbaum: WG3
temp <- df_dt_test_WG3 %>%
  mutate(Verfahren="DT") %>%
  mutate(Modell="WG32") %>%
  mutate(Warengruppe=3) %>%
  group_by(Verfahren, Modell, Warengruppe) %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# Anfügen der Ergebnisse an die Vergleichstabelle
modell_vergleich_WG <- rbind(modell_vergleich_WG, temp)

# bester Entscheidungsbaum: WG4
temp <- df_dt_test_WG4 %>%
  mutate(Verfahren="DT") %>%
  mutate(Modell="WG4") %>%
  mutate(Warengruppe=4) %>%
  group_by(Verfahren, Modell, Warengruppe) %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# Anfügen der Ergebnisse an die Vergleichstabelle
modell_vergleich_WG <- rbind(modell_vergleich_WG, temp)

# bester Entscheidungsbaum: WG5
temp <- df_dt_test_WG5 %>%
  mutate(Verfahren="DT") %>%
  mutate(Modell="WG5") %>%
  mutate(Warengruppe=5) %>%
  group_by(Verfahren, Modell, Warengruppe) %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# Anfügen der Ergebnisse an die Vergleichstabelle
modell_vergleich_WG <- rbind(modell_vergleich_WG, temp)

# bestes SVM Modell: WG1
temp <- df_SVM_test_WG1 %>%
  mutate(Verfahren="SVM") %>%
  mutate(Modell="WG1") %>%
  mutate(Warengruppe=1) %>%
  group_by(Verfahren, Modell, Warengruppe) %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# Anfügen der Ergebnisse an die Vergleichstabelle
modell_vergleich_WG <- rbind(modell_vergleich_WG, temp) 

# bestes SVM Modell: WG2
temp <- df_SVM_test_WG2 %>%
  mutate(Verfahren="SVM") %>%
  mutate(Modell="WG2") %>%
  mutate(Warengruppe=2) %>%
  group_by(Verfahren, Modell, Warengruppe) %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# Anfügen der Ergebnisse an die Vergleichstabelle
modell_vergleich_WG <- rbind(modell_vergleich_WG, temp) 

# bestes SVM Modell: WG3
temp <- df_SVM_test_WG3 %>%
  mutate(Verfahren="SVM") %>%
  mutate(Modell="WG3") %>%
  mutate(Warengruppe=3) %>%
  group_by(Verfahren, Modell, Warengruppe) %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# Anfügen der Ergebnisse an die Vergleichstabelle
modell_vergleich_WG <- rbind(modell_vergleich_WG, temp) 

# bestes SVM Modell: WG4
temp <- df_SVM_test_WG4 %>%
  mutate(Verfahren="SVM") %>%
  mutate(Modell="WG4") %>%
  mutate(Warengruppe=4) %>%
  group_by(Verfahren, Modell, Warengruppe) %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# Anfügen der Ergebnisse an die Vergleichstabelle
modell_vergleich_WG <- rbind(modell_vergleich_WG, temp) 

# bestes SVM Modell: WG5
temp <- df_SVM_test_WG5 %>%
  mutate(Verfahren="SVM") %>%
  mutate(Modell="WG5") %>%
  mutate(Warengruppe=5) %>%
  group_by(Verfahren, Modell, Warengruppe) %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# Anfügen der Ergebnisse an die Vergleichstabelle
modell_vergleich_WG <- rbind(modell_vergleich_WG, temp) 

# bestes MLP Modell: WG1
temp <- df_MLP_test_mod2_WG1 %>%
  mutate(Verfahren="MLP") %>%
  mutate(Modell="mod2") %>%
  mutate(Warengruppe=1) %>%
  group_by(Verfahren, Modell, Warengruppe) %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# Anfügen der Ergebnisse an die Vergleichstabelle
modell_vergleich_WG <- rbind(modell_vergleich_WG, temp) 

# bestes MLP Modell: WG2
temp <- df_MLP_test_mod4_WG2 %>%
  mutate(Verfahren="MLP") %>%
  mutate(Modell="mod4") %>%
  mutate(Warengruppe=2) %>%
  group_by(Verfahren, Modell, Warengruppe) %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# Anfügen der Ergebnisse an die Vergleichstabelle
modell_vergleich_WG <- rbind(modell_vergleich_WG, temp) 

# bestes MLP Modell: WG3
temp <- df_MLP_test_mod2_WG3 %>%
  mutate(Verfahren="MLP") %>%
  mutate(Modell="mod2") %>%
  mutate(Warengruppe=3) %>%
  group_by(Verfahren, Modell, Warengruppe) %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# Anfügen der Ergebnisse an die Vergleichstabelle
modell_vergleich_WG <- rbind(modell_vergleich_WG, temp) 

# bestes MLP Modell: WG4
temp <- df_MLP_test_mod2_WG4 %>%
  mutate(Verfahren="MLP") %>%
  mutate(Modell="mod2") %>%
  mutate(Warengruppe=4) %>%
  group_by(Verfahren, Modell, Warengruppe) %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# Anfügen der Ergebnisse an die Vergleichstabelle
modell_vergleich_WG <- rbind(modell_vergleich_WG, temp) 

# bestes MLP Modell: WG5
temp <- df_MLP_test_mod2_WG5 %>%
  mutate(Verfahren="MLP") %>%
  mutate(Modell="mod2") %>%
  mutate(Warengruppe=5) %>%
  group_by(Verfahren, Modell, Warengruppe) %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# Anfügen der Ergebnisse an die Vergleichstabelle
modell_vergleich_WG <- rbind(modell_vergleich_WG, temp) 

Jetzt wollen wir für jede Warengruppe prüfen, welches Verfahren mit welchem Modell die besten Prognosen liefert. Und zwar bewerten wir das anhand der folgenden drei Gütekennzahlen:

  • MPE (Mean Percentage Error): Die mittlere relative Abweichung gibt uns ein Indiz dafür, ob unser Modell die Umsätze systematisch zu hoch oder zu niedrig schätzt. Wir wollen natürlich möglichst einen Mittelwert nahe Null erzielen. Falls ein Modell jedoch den Umsatz systematisch zu hoch oder zu niedrig schätzt und ansonsten hervoragende Gütekennzahlen aufweist, kann man die Schätzwerte mit einem Offset korrigieren um eben diese mittlere relative Abweichung.
  • WAPE (Weighted Absolute Percent Error): Der gewichtete Mittelwert des Absolutwertes der relativen Abweichung ist für das wichtigste Bewertungskriterium, weil es die Prognosegüte insgesamt am besten misst. Dabei gilt: Je kleiner, desto besser.
  • rRMSE (relative Root Mean Square Error): Der Mittelwert der Wurzel der quadratischen Abweichung - ins Verhältnis gesetzt zum mittleren Umsatz - liefert uns Anhaltspunkte, ob vermehrt größere Abweichungen zwischen geschätztem und tatsächlichem Umsatz vorliegen. Wir wollen also hier möglichst niedrige Werte finden.
## # A tibble: 5 x 13
## # Groups:   Verfahren, Modell [5]
##   Verfahren Modell Warengruppe Anzahl Umsatz_ges Umsatz_mittel   MAE   MPE
##   <chr>     <chr>        <dbl>  <int>      <dbl>         <dbl> <dbl> <dbl>
## 1 lm        best21           1    346      45738           132    25    -8
## 2 SVM       WG1              1    346      45738           132    25    -6
## 3 MLP       mod2             1    346      45738           132    27    -4
## 4 DT        WG1              1    346      45738           132    28    -6
## 5 naiv      glDS_~           1    358      47292           132    30     9
## # ... with 5 more variables: MAPE <dbl>, WAPE <dbl>, MSE <dbl>,
## #   RMSE <dbl>, rRMSE <dbl>

Für die Warengruppe 1 liefert das lineare Modell insgesamt betrachtet den besten Schätzer. MAPE, WAPE und rRMSE sind bei diesem Modell am niedrigsten. Der MPE ist zwar am zweitschlechtesten, doch wie angeführt, könnte man die Schätzwerte mit einem Offset korrigieren.

## # A tibble: 5 x 13
## # Groups:   Verfahren, Modell [5]
##   Verfahren Modell Warengruppe Anzahl Umsatz_ges Umsatz_mittel   MAE   MPE
##   <chr>     <chr>        <dbl>  <int>      <dbl>         <dbl> <dbl> <dbl>
## 1 MLP       mod4             2    346     130413           377    39     2
## 2 naiv      glDS_~           2    358     135858           379    41     1
## 3 lm        best24           2    346     130413           377    40     3
## 4 SVM       WG2              2    346     130413           377    42     2
## 5 DT        WG2              2    346     130413           377    50     4
## # ... with 5 more variables: MAPE <dbl>, WAPE <dbl>, MSE <dbl>,
## #   RMSE <dbl>, rRMSE <dbl>

Für Warengruppe 2 liefern alle Modelle relativ gute Ergebnisse. Das MLP Modell (mod4) hat knapp die Nase vorn.

## # A tibble: 5 x 13
## # Groups:   Verfahren, Modell [5]
##   Verfahren Modell Warengruppe Anzahl Umsatz_ges Umsatz_mittel   MAE   MPE
##   <chr>     <chr>        <dbl>  <int>      <dbl>         <dbl> <dbl> <dbl>
## 1 naiv      glDS_~           3    358      61867           173    26     3
## 2 lm        best30           3    346      59316           171    31    -8
## 3 SVM       WG3              3    346      59316           171    32    -7
## 4 MLP       mod2             3    346      59316           171    34    -9
## 5 DT        WG32             3    346      59316           171    36    -7
## # ... with 5 more variables: MAPE <dbl>, WAPE <dbl>, MSE <dbl>,
## #   RMSE <dbl>, rRMSE <dbl>

Für Warengruppe 3 gewinnt sehr deutlich das naive Modell.

## # A tibble: 5 x 13
## # Groups:   Verfahren, Modell [5]
##   Verfahren Modell Warengruppe Anzahl Umsatz_ges Umsatz_mittel   MAE   MPE
##   <chr>     <chr>        <dbl>  <int>      <dbl>         <dbl> <dbl> <dbl>
## 1 naiv      glDS_~           4    357      29606            83    17     5
## 2 DT        WG4              4    345      28354            82    17     6
## 3 lm        best1            4    345      28354            82    18    14
## 4 MLP       mod2             4    345      28354            82    18     5
## 5 SVM       WG4              4    345      28354            82    19    14
## # ... with 5 more variables: MAPE <dbl>, WAPE <dbl>, MSE <dbl>,
## #   RMSE <dbl>, rRMSE <dbl>

Für Warengruppe 4 gewinnt wieder das naive Modell, wenngleich auch der DT und das MLP gut performen. Bei diesen Modellen ist jedoch ein vergleichsweise hoher rRMSE zu beobachten.

## # A tibble: 5 x 13
## # Groups:   Verfahren, Modell [5]
##   Verfahren Modell Warengruppe Anzahl Umsatz_ges Umsatz_mittel   MAE   MPE
##   <chr>     <chr>        <dbl>  <int>      <dbl>         <dbl> <dbl> <dbl>
## 1 lm        best8            5    346      93912           271    39     1
## 2 DT        WG5              5    346      93912           271    41     0
## 3 naiv      glDS_~           5    358      97639           273    43     2
## 4 SVM       WG5              5    346      93912           271    43     0
## 5 MLP       mod2             5    346      93912           271    43    -1
## # ... with 5 more variables: MAPE <dbl>, WAPE <dbl>, MSE <dbl>,
## #   RMSE <dbl>, rRMSE <dbl>

Für Warengruppe 5 gewinnt das lineare Modell, gefolgt vom DT, der jedoch einen deutlich schlechteren rRMSE aufweist.

11 Ensemble Methoden

Wir haben im letzten Abschnitt für jede Warengruppe die besten Einzelmodelle der verschiedenen Verfahren identifiziert. Als nächsten wollen wir eine Kombination dieser besten Einzelmodelle - ein sogenanntes Ensemble - bilden, in der Hoffnung, dass sich dadurch noch bessere Prognosen erstellen lassen.

Zuerst stellen wir die Schätzer in einer gemeinsamen Tabelle zusammen, wobei wir eine Tabelle je Warengruppe bilden. Die Basis bilden die Ergebnisse des besten naiven Modells (glDS_4T_erw).

# Warengruppe 1
# bestes naives Modell
ensemble_WG1 <- prog_naiv_glDS_4T_erw %>%
  group_by() %>%
  na.omit() %>%
  filter(Jahr == 2018 & Warengruppe == 1 & Umsatz_NA == FALSE) %>%
  dplyr::select(Datum, Warengruppe, Umsatz, Umsatz_glDS_4T_erw) %>%
  mutate(Umsatz_naiv = Umsatz_glDS_4T_erw) %>%
  dplyr::select(-Umsatz_glDS_4T_erw)

# bestes lineares Modell
temp <- df_lm_test_WG1_21 %>%
  dplyr::select(predicted) %>%
  mutate(Umsatz_lm = predicted) %>%
  dplyr::select(-predicted)

# Anfügen ans Ensemble
ensemble_WG1 <- cbind(ensemble_WG1, temp)

# bester DT
temp <- df_dt_test_WG1 %>%
  dplyr::select(predicted) %>%
  mutate(Umsatz_dt = predicted) %>%
  dplyr::select(-predicted)

# Anfügen ans Ensemble
ensemble_WG1 <- cbind(ensemble_WG1, temp)

# bestes SVM Modell
temp <- df_SVM_test_WG1 %>%
  dplyr::select(Umsatz_WG1) %>%
  mutate(Umsatz_SVM = Umsatz_WG1) %>%
  dplyr::select(-Umsatz_WG1)

# Anfügen ans Ensemble
ensemble_WG1 <- cbind(ensemble_WG1, temp)

# bestes MLP Modell
temp <- df_MLP_test_mod2_WG1 %>%
  dplyr::select(Umsatz_mod2_WG1) %>%
  mutate(Umsatz_MLP = Umsatz_mod2_WG1) %>%
  dplyr::select(-Umsatz_mod2_WG1)

# Anfügen ans Ensemble
ensemble_WG1 <- cbind(ensemble_WG1, temp)


# Warengruppe 2
# bestes naives Modell
ensemble_WG2 <- prog_naiv_glDS_4T_erw %>%
  group_by() %>%
  na.omit() %>%
  filter(Jahr == 2018 & Warengruppe == 2 & Umsatz_NA == FALSE) %>%
  dplyr::select(Datum, Warengruppe, Umsatz, Umsatz_glDS_4T_erw) %>%
  mutate(Umsatz_naiv = Umsatz_glDS_4T_erw) %>%
  dplyr::select(-Umsatz_glDS_4T_erw)

# bestes lineares Modell
temp <- df_lm_test_WG2_24 %>%
  dplyr::select(predicted) %>%
  mutate(Umsatz_lm = predicted) %>%
  dplyr::select(-predicted)

# Anfügen ans Ensemble
ensemble_WG2 <- cbind(ensemble_WG2, temp)

# bester DT
temp <- df_dt_test_WG2 %>%
  dplyr::select(predicted) %>%
  mutate(Umsatz_dt = predicted) %>%
  dplyr::select(-predicted)

# Anfügen ans Ensemble
ensemble_WG2 <- cbind(ensemble_WG2, temp)

# bestes SVM Modell
temp <- df_SVM_test_WG2 %>%
  dplyr::select(Umsatz_WG2) %>%
  mutate(Umsatz_SVM = Umsatz_WG2) %>%
  dplyr::select(-Umsatz_WG2)

# Anfügen ans Ensemble
ensemble_WG2 <- cbind(ensemble_WG2, temp)

# bestes MLP Modell
temp <- df_MLP_test_mod4_WG2 %>%
  dplyr::select(Umsatz_mod4_WG2) %>%
  mutate(Umsatz_MLP = Umsatz_mod4_WG2) %>%
  dplyr::select(-Umsatz_mod4_WG2)

# Anfügen ans Ensemble
ensemble_WG2 <- cbind(ensemble_WG2, temp)


# Warengruppe 3
# bestes naives Modell
ensemble_WG3 <- prog_naiv_glDS_4T_erw %>%
  group_by() %>%
  na.omit() %>%
  filter(Jahr == 2018 & Warengruppe == 3 & Umsatz_NA == FALSE) %>%
  dplyr::select(Datum, Warengruppe, Umsatz, Umsatz_glDS_4T_erw) %>%
  mutate(Umsatz_naiv = Umsatz_glDS_4T_erw) %>%
  dplyr::select(-Umsatz_glDS_4T_erw)

# bestes lineares Modell
temp <- df_lm_test_WG3_30 %>%
  dplyr::select(predicted) %>%
  mutate(Umsatz_lm = predicted) %>%
  dplyr::select(-predicted)

# Anfügen ans Ensemble
ensemble_WG3 <- cbind(ensemble_WG3, temp)

# bester DT
temp <- df_dt_test_WG3 %>%
  dplyr::select(predicted) %>%
  mutate(Umsatz_dt = predicted) %>%
  dplyr::select(-predicted)

# Anfügen ans Ensemble
ensemble_WG3 <- cbind(ensemble_WG3, temp)

# bestes SVM Modell
temp <- df_SVM_test_WG3 %>%
  dplyr::select(Umsatz_WG3) %>%
  mutate(Umsatz_SVM = Umsatz_WG3) %>%
  dplyr::select(-Umsatz_WG3)

# Anfügen ans Ensemble
ensemble_WG3 <- cbind(ensemble_WG3, temp)

# bestes MLP Modell
temp <- df_MLP_test_mod2_WG3 %>%
  dplyr::select(Umsatz_mod2_WG3) %>%
  mutate(Umsatz_MLP = Umsatz_mod2_WG3) %>%
  dplyr::select(-Umsatz_mod2_WG3)

# Anfügen ans Ensemble
ensemble_WG3 <- cbind(ensemble_WG3, temp)


# Warengruppe 4
# bestes naives Modell
ensemble_WG4 <- prog_naiv_glDS_4T_erw %>%
  group_by() %>%
  na.omit() %>%
  filter(Jahr == 2018 & Warengruppe == 4 & Umsatz_NA == FALSE) %>%
  dplyr::select(Datum, Warengruppe, Umsatz, Umsatz_glDS_4T_erw) %>%
  mutate(Umsatz_naiv = Umsatz_glDS_4T_erw) %>%
  dplyr::select(-Umsatz_glDS_4T_erw)

# bestes lineares Modell
temp <- df_lm_test_WG4_1 %>%
  dplyr::select(predicted) %>%
  mutate(Umsatz_lm = predicted) %>%
  dplyr::select(-predicted)

# Anfügen ans Ensemble
ensemble_WG4 <- cbind(ensemble_WG4, temp)

# bester DT
temp <- df_dt_test_WG4 %>%
  dplyr::select(predicted) %>%
  mutate(Umsatz_dt = predicted) %>%
  dplyr::select(-predicted)

# Anfügen ans Ensemble
ensemble_WG4 <- cbind(ensemble_WG4, temp)

# bestes SVM Modell
temp <- df_SVM_test_WG4 %>%
  dplyr::select(Umsatz_WG4) %>%
  mutate(Umsatz_SVM = Umsatz_WG4) %>%
  dplyr::select(-Umsatz_WG4)

# Anfügen ans Ensemble
ensemble_WG4 <- cbind(ensemble_WG4, temp)

# bestes MLP Modell
temp <- df_MLP_test_mod2_WG4 %>%
  dplyr::select(Umsatz_mod2_WG4) %>%
  mutate(Umsatz_MLP = Umsatz_mod2_WG4) %>%
  dplyr::select(-Umsatz_mod2_WG4)

# Anfügen ans Ensemble
ensemble_WG4 <- cbind(ensemble_WG4, temp)


# Warengruppe 5
# bestes naives Modell
ensemble_WG5 <- prog_naiv_glDS_4T_erw %>%
  group_by() %>%
  na.omit() %>%
  filter(Jahr == 2018 & Warengruppe == 5 & Umsatz_NA == FALSE) %>%
  dplyr::select(Datum, Warengruppe, Umsatz, Umsatz_glDS_4T_erw) %>%
  mutate(Umsatz_naiv = Umsatz_glDS_4T_erw) %>%
  dplyr::select(-Umsatz_glDS_4T_erw)

# bestes lineares Modell
temp <- df_lm_test_WG5_8 %>%
  dplyr::select(predicted) %>%
  mutate(Umsatz_lm = predicted) %>%
  dplyr::select(-predicted)

# Anfügen ans Ensemble
ensemble_WG5 <- cbind(ensemble_WG5, temp)

# bester DT
temp <- df_dt_test_WG5 %>%
  dplyr::select(predicted) %>%
  mutate(Umsatz_dt = predicted) %>%
  dplyr::select(-predicted)

# Anfügen ans Ensemble
ensemble_WG5 <- cbind(ensemble_WG5, temp)

# bestes SVM Modell
temp <- df_SVM_test_WG5 %>%
  dplyr::select(Umsatz_WG5) %>%
  mutate(Umsatz_SVM = Umsatz_WG5) %>%
  dplyr::select(-Umsatz_WG5)

# Anfügen ans Ensemble
ensemble_WG5 <- cbind(ensemble_WG5, temp)

# bestes MLP Modell
temp <- df_MLP_test_mod2_WG5 %>%
  dplyr::select(Umsatz_mod2_WG5) %>%
  mutate(Umsatz_MLP = Umsatz_mod2_WG5) %>%
  dplyr::select(-Umsatz_mod2_WG5)

# Anfügen ans Ensemble
ensemble_WG5 <- cbind(ensemble_WG5, temp)

Wir bilden nun den Ensemble-Schätzer als Mittelwert der besten Einzelschätzer. Anschließend ermitteln wir die Gütekennzahlen. Die Ergebnisse für die Warengruppen sammeln wir in einer gemeinsamen Tabelle ensemble_WG_vgl.

# Warengruppe 1
# bilde Ensemble-Umsatz
ensemble_WG1 <- ensemble_WG1 %>% 
  mutate(Umsatz_ensemble = (Umsatz_naiv + Umsatz_lm + Umsatz_dt + Umsatz_SVM + Umsatz_MLP) / 5)

# bilde Hilfsgrößen für die spätere Ermittlung der Gütemaße
ensemble_WG1 <- ensemble_WG1 %>%
  mutate(Prognose_zuhoch = (Umsatz_ensemble >= Umsatz)) %>%
  mutate(Abweichung = Umsatz_ensemble - Umsatz) %>%
  mutate(Abweichung_abs = abs(Umsatz_ensemble - Umsatz)) %>%
  mutate(Abweichung_rel = (Umsatz_ensemble - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# ergänze die Anzahl
ensemble_WG1 <- ensemble_WG1 %>%
  group_by(Warengruppe) %>%
  mutate(Anzahl = n())

# ergänze eine weitere Hilfsgröße
ensemble_WG1 <- ensemble_WG1 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# ermittle die Gütemaße
ensemble_WG_vgl <- ensemble_WG1 %>%
  group_by() %>%
  mutate(Verfahren="Ensemble") %>%
  mutate(Modell="MW") %>%
  mutate(Warengruppe=1) %>%
  group_by(Verfahren, Modell, Warengruppe) %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))


# Warengruppe 2
# bilde Ensemble-Umsatz
ensemble_WG2 <- ensemble_WG2 %>% 
  mutate(Umsatz_ensemble = (Umsatz_naiv + Umsatz_lm + Umsatz_dt + Umsatz_SVM + Umsatz_MLP) / 5)

# bilde Hilfsgrößen für die spätere Ermittlung der Gütemaße
ensemble_WG2 <- ensemble_WG2 %>%
  mutate(Prognose_zuhoch = (Umsatz_ensemble >= Umsatz)) %>%
  mutate(Abweichung = Umsatz_ensemble - Umsatz) %>%
  mutate(Abweichung_abs = abs(Umsatz_ensemble - Umsatz)) %>%
  mutate(Abweichung_rel = (Umsatz_ensemble - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# ergänze die Anzahl
ensemble_WG2 <- ensemble_WG2 %>%
  group_by(Warengruppe) %>%
  mutate(Anzahl = n())

# ergänze eine weitere Hilfsgröße
ensemble_WG2 <- ensemble_WG2 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# ermittle die Gütemaße
temp <- ensemble_WG2 %>%
  group_by() %>%
  mutate(Verfahren="Ensemble") %>%
  mutate(Modell="MW") %>%
  mutate(Warengruppe=2) %>%
  group_by(Verfahren, Modell, Warengruppe) %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# Anfügen an Vergleichstabelle
ensemble_WG_vgl <- rbind(ensemble_WG_vgl, temp)


# Warengruppe 3
# bilde Ensemble-Umsatz
ensemble_WG3 <- ensemble_WG3 %>% 
  mutate(Umsatz_ensemble = (Umsatz_naiv + Umsatz_lm + Umsatz_dt + Umsatz_SVM + Umsatz_MLP) / 5)

# bilde Hilfsgrößen für die spätere Ermittlung der Gütemaße
ensemble_WG3 <- ensemble_WG3 %>%
  mutate(Prognose_zuhoch = (Umsatz_ensemble >= Umsatz)) %>%
  mutate(Abweichung = Umsatz_ensemble - Umsatz) %>%
  mutate(Abweichung_abs = abs(Umsatz_ensemble - Umsatz)) %>%
  mutate(Abweichung_rel = (Umsatz_ensemble - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# ergänze die Anzahl
ensemble_WG3 <- ensemble_WG3 %>%
  group_by(Warengruppe) %>%
  mutate(Anzahl = n())

# ergänze eine weitere Hilfsgröße
ensemble_WG3 <- ensemble_WG3 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# ermittle die Gütemaße
temp <- ensemble_WG3 %>%
  group_by() %>%
  mutate(Verfahren="Ensemble") %>%
  mutate(Modell="MW") %>%
  mutate(Warengruppe=3) %>%
  group_by(Verfahren, Modell, Warengruppe) %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# Anfügen an Vergleichstabelle
ensemble_WG_vgl <- rbind(ensemble_WG_vgl, temp)


# Warengruppe 4
# bilde Ensemble-Umsatz
ensemble_WG4 <- ensemble_WG4 %>% 
  mutate(Umsatz_ensemble = (Umsatz_naiv + Umsatz_lm + Umsatz_dt + Umsatz_SVM + Umsatz_MLP) / 5)

# bilde Hilfsgrößen für die spätere Ermittlung der Gütemaße
ensemble_WG4 <- ensemble_WG4 %>%
  mutate(Prognose_zuhoch = (Umsatz_ensemble >= Umsatz)) %>%
  mutate(Abweichung = Umsatz_ensemble - Umsatz) %>%
  mutate(Abweichung_abs = abs(Umsatz_ensemble - Umsatz)) %>%
  mutate(Abweichung_rel = (Umsatz_ensemble - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# ergänze die Anzahl
ensemble_WG4 <- ensemble_WG4 %>%
  group_by(Warengruppe) %>%
  mutate(Anzahl = n())

# ergänze eine weitere Hilfsgröße
ensemble_WG4 <- ensemble_WG4 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# ermittle die Gütemaße
temp <- ensemble_WG4 %>%
  group_by() %>%
  mutate(Verfahren="Ensemble") %>%
  mutate(Modell="MW") %>%
  mutate(Warengruppe=4) %>%
  group_by(Verfahren, Modell, Warengruppe) %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# Anfügen an Vergleichstabelle
ensemble_WG_vgl <- rbind(ensemble_WG_vgl, temp)


# Warengruppe 5
# bilde Ensemble-Umsatz
ensemble_WG5 <- ensemble_WG5 %>% 
  mutate(Umsatz_ensemble = (Umsatz_naiv + Umsatz_lm + Umsatz_dt + Umsatz_SVM + Umsatz_MLP) / 5)

# bilde Hilfsgrößen für die spätere Ermittlung der Gütemaße
ensemble_WG5 <- ensemble_WG5 %>%
  mutate(Prognose_zuhoch = (Umsatz_ensemble >= Umsatz)) %>%
  mutate(Abweichung = Umsatz_ensemble - Umsatz) %>%
  mutate(Abweichung_abs = abs(Umsatz_ensemble - Umsatz)) %>%
  mutate(Abweichung_rel = (Umsatz_ensemble - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# ergänze die Anzahl
ensemble_WG5 <- ensemble_WG5 %>%
  group_by(Warengruppe) %>%
  mutate(Anzahl = n())

# ergänze eine weitere Hilfsgröße
ensemble_WG5 <- ensemble_WG5 %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# ermittle die Gütemaße
temp <- ensemble_WG5 %>%
  group_by() %>%
  mutate(Verfahren="Ensemble") %>%
  mutate(Modell="MW") %>%
  mutate(Warengruppe=5) %>%
  group_by(Verfahren, Modell, Warengruppe) %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# Anfügen an Vergleichstabelle
ensemble_WG_vgl <- rbind(ensemble_WG_vgl, temp)

Die Gütekennzahlen für die Ensemble-Modelle fügen wir nun an die oben ermittelte Vergleichstabelle modell_vergleich_WG an.

Und schließlich vergleichen wir die besten Einzelmodelle je Warengruppe nun zusätzlich mit dem Ensemble-Schätzer.

## # A tibble: 6 x 13
## # Groups:   Verfahren, Modell [6]
##   Verfahren Modell Warengruppe Anzahl Umsatz_ges Umsatz_mittel   MAE   MPE
##   <chr>     <chr>        <dbl>  <int>      <dbl>         <dbl> <dbl> <dbl>
## 1 Ensemble  MW               1    346      45738           132    24    -3
## 2 lm        best21           1    346      45738           132    25    -8
## 3 SVM       WG1              1    346      45738           132    25    -6
## 4 MLP       mod2             1    346      45738           132    27    -4
## 5 DT        WG1              1    346      45738           132    28    -6
## 6 naiv      glDS_~           1    358      47292           132    30     9
## # ... with 5 more variables: MAPE <dbl>, WAPE <dbl>, MSE <dbl>,
## #   RMSE <dbl>, rRMSE <dbl>

Für die Warengruppe 1 liefert das Ensemble den besten Schätzer und hat das lineare Modell auf den 2. Platz verwiesen, zumindest was den WAPE anbelangt, den wir als Kriterium für die Rangfolge festgelegt haben.In Sachen rRMSE performt das lineare Modell weiterhin besser.

Für Warengruppe 1 konnten wir durch die Ensemble-Bildung den Schätzer also noch verbessern.

## # A tibble: 6 x 13
## # Groups:   Verfahren, Modell [6]
##   Verfahren Modell Warengruppe Anzahl Umsatz_ges Umsatz_mittel   MAE   MPE
##   <chr>     <chr>        <dbl>  <int>      <dbl>         <dbl> <dbl> <dbl>
## 1 MLP       mod4             2    346     130413           377    39     2
## 2 Ensemble  MW               2    346     130413           377    36     3
## 3 naiv      glDS_~           2    358     135858           379    41     1
## 4 lm        best24           2    346     130413           377    40     3
## 5 SVM       WG2              2    346     130413           377    42     2
## 6 DT        WG2              2    346     130413           377    50     4
## # ... with 5 more variables: MAPE <dbl>, WAPE <dbl>, MSE <dbl>,
## #   RMSE <dbl>, rRMSE <dbl>

Für Warengruppe 2 erreicht das Ensemble den zweiten Platz und bleibt damit knapp hinter dem MLP zurück.

## # A tibble: 6 x 13
## # Groups:   Verfahren, Modell [6]
##   Verfahren Modell Warengruppe Anzahl Umsatz_ges Umsatz_mittel   MAE   MPE
##   <chr>     <chr>        <dbl>  <int>      <dbl>         <dbl> <dbl> <dbl>
## 1 naiv      glDS_~           3    358      61867           173    26     3
## 2 Ensemble  MW               3    346      59316           171    28    -6
## 3 lm        best30           3    346      59316           171    31    -8
## 4 SVM       WG3              3    346      59316           171    32    -7
## 5 MLP       mod2             3    346      59316           171    34    -9
## 6 DT        WG32             3    346      59316           171    36    -7
## # ... with 5 more variables: MAPE <dbl>, WAPE <dbl>, MSE <dbl>,
## #   RMSE <dbl>, rRMSE <dbl>

Für Warengruppe 3 liefert nach wie vor das naive Modell die besten Schätzer, allerdings nur knapp vor dem Ensemble-Modell.

## # A tibble: 6 x 13
## # Groups:   Verfahren, Modell [6]
##   Verfahren Modell Warengruppe Anzahl Umsatz_ges Umsatz_mittel   MAE   MPE
##   <chr>     <chr>        <dbl>  <int>      <dbl>         <dbl> <dbl> <dbl>
## 1 Ensemble  MW               4    345      28354            82    16     9
## 2 naiv      glDS_~           4    357      29606            83    17     5
## 3 DT        WG4              4    345      28354            82    17     6
## 4 lm        best1            4    345      28354            82    18    14
## 5 MLP       mod2             4    345      28354            82    18     5
## 6 SVM       WG4              4    345      28354            82    19    14
## # ... with 5 more variables: MAPE <dbl>, WAPE <dbl>, MSE <dbl>,
## #   RMSE <dbl>, rRMSE <dbl>

Für Warengruppe 4 können wir mit dem Ensemble die Prognosegüte noch minimal verbessern.

## # A tibble: 6 x 13
## # Groups:   Verfahren, Modell [6]
##   Verfahren Modell Warengruppe Anzahl Umsatz_ges Umsatz_mittel   MAE   MPE
##   <chr>     <chr>        <dbl>  <int>      <dbl>         <dbl> <dbl> <dbl>
## 1 lm        best8            5    346      93912           271    39     1
## 2 Ensemble  MW               5    346      93912           271    37     1
## 3 DT        WG5              5    346      93912           271    41     0
## 4 naiv      glDS_~           5    358      97639           273    43     2
## 5 SVM       WG5              5    346      93912           271    43     0
## 6 MLP       mod2             5    346      93912           271    43    -1
## # ... with 5 more variables: MAPE <dbl>, WAPE <dbl>, MSE <dbl>,
## #   RMSE <dbl>, rRMSE <dbl>

Für Warengruppe 5 gewinnt das lineare Modell, jetzt knapp vor dem Ensemble-Modell.

Insgesamt gelingt die Umsatzschätzung für die Warengruppe 2 (= Brötchen) am besten. Wir wollen uns exemplarisch für diese Warengruppe daher noch die Verteilung der relativen Abweichungen der Umsatzschätzung vom tatsächlichen Umsatz angucken und erstellen dafür eine weitere Vergleichstabelle ensemble_WG2_vgl_relAbw. Diese müssen wir dann noch pivotisieren (pivot_longer) als Vorbereitung auf den Boxplot:

# füge die relativen Abweichungen für das naive Modell an
ensemble_WG2_vgl_relAbw <- ensemble_WG2 %>% 
  group_by() %>%
  mutate(naiv = (Umsatz_naiv - Umsatz) / Umsatz) %>%
  dplyr::select(Datum, naiv)
  
# füge die relativen Abweichungen für das lineare Modell an
ensemble_WG2_vgl_relAbw <- left_join(ensemble_WG2_vgl_relAbw, ensemble_WG2 %>% 
  group_by() %>% mutate(lm = (Umsatz_lm - Umsatz) / Umsatz) %>%
  dplyr::select(Datum, lm),by="Datum")

# füge die relativen Abweichungen für das DT Modell an
ensemble_WG2_vgl_relAbw <- left_join(ensemble_WG2_vgl_relAbw, ensemble_WG2 %>% 
  group_by() %>% mutate(dt = (Umsatz_dt - Umsatz) / Umsatz) %>%
  dplyr::select(Datum, dt),by="Datum")

# füge die relativen Abweichungen für das SVM Modell an
ensemble_WG2_vgl_relAbw <- left_join(ensemble_WG2_vgl_relAbw, ensemble_WG2 %>% 
  group_by() %>% mutate(SVM = (Umsatz_SVM - Umsatz) / Umsatz) %>%
  dplyr::select(Datum, SVM),by="Datum")

# füge die relativen Abweichungen für das MLP Modell an
ensemble_WG2_vgl_relAbw <- left_join(ensemble_WG2_vgl_relAbw, ensemble_WG2 %>% 
  group_by() %>% mutate(MLP = (Umsatz_MLP - Umsatz) / Umsatz) %>%
  dplyr::select(Datum, MLP),by="Datum")

# füge die relativen Abweichungen für das Ensemble Modell an
ensemble_WG2_vgl_relAbw <- left_join(ensemble_WG2_vgl_relAbw, ensemble_WG2 %>% 
  group_by() %>% mutate(Ensemble = (Umsatz_ensemble - Umsatz) / Umsatz) %>%
  dplyr::select(Datum, Ensemble),by="Datum")

# pivotisieren
ensemble_WG2_vgl_relAbw <- ensemble_WG2_vgl_relAbw %>% 
  pivot_longer(cols=-c("Datum"), names_to="Modell", values_to="Abweichung_rel")

# Boxplot
ensemble_WG2_vgl_relAbw %>%
  ggplot(mapping=aes(x=Modell, y=Abweichung_rel*100)) +
  geom_boxplot() + coord_flip() +
  ggtitle("2018 - WG2, Vergleich der besten Modelle: Rel. Abweichung") +
  xlab("Modell") + 
  ylab("rel. Abweichung (%)") +
  ylim(-100, 200)

Wir sehen inder Tat, dass sich die Umsätze für die Warengruppe 2 sehr gut prognostizieren lassen. Die Verteilungen der relativen Abweichungen sind verhältnismäßig schmal.

12 Zusammenfassung und Ausblick

Die nachfolgende Tabelle ermöglicht einen Vergleich der angewendeten Modelle für alle Warengruppen:

Im Vergleich der besten Einzelmodelle finden wir ein Kopf-an-Kopf-Rennen zwischen dem besten naiven Modell und den linearen Modellen, aber auch das MLP ist bei den besten Schätzern vertreten, zumindest für eine Warengruppe. Die Entscheidungsbäume performen für die Warengruppen 1, 2 und 3 eher schlecht, für die Warengruppen 4 und 5 jedoch sehr gut (jeweils Platz 2). Die Support Vector Machines liefern insgesamt etwas schlechtere Ergebnisse. Das zeigt zum einen, dass es sehr viel Erfahrung braucht, um diese komplexen Modelle zu optimieren. Diese Erfahrung fehlt uns.

Ein weiterer Aspekt ist, dass wir alle Modelle statisch auf die Testdaten für das Jahr 2018 angewendet und die Ergebnisse verglichen haben. In einer Ausbaustufe könnte man stattdessen die komplexen Modelle nach-trainieren. Konkret könnte man dazu bspw. für die Ermittlung der Februar-Prognose schon die dann bekannten Januar-Werte aus 2018 nutzen, um die Modellparameter anzupassen. Dieses rollierende Verfahren wurde hier jedoch nicht angewendet. Die ermittelten Gütemaße könnten für die komplexen Modelle dadurch sicherlich noch verbessert werden.

Auf der anderen Seite lassen sich die Umsätze mit unserem Datenmodell vielleicht auch gar nicht besser schätzen. Möglicherweise bringt erst die Berücksichtigung weiterer Einflussfaktoren genauere Schätzergebnisse, hier aber nicht weiter vertieft.

Durch einfache Ensemble-Bildung als Mittelwert der besten Einzelschätzer konnten wir für die Warengruppen 1 und 4 die Prognosegüte noch verbessern. Bei den anderen Warengruppen reicht es zwar “nur” für den 2. Platz, aber es wird deutlich, dass schon durch eine solch einfache Ensemble-Bildung sichtbar Verbesserungen gegenüber Einzelmodellen erzielt werden können.

Insgesamt lassen sich die Umsätze für die Warengruppe 2 (= Brötchen) am treffsichersten voraussagen. Brötchen scheinen also eine “Konstante” im Leben vieler Menschen hierzulande zu sein.

Christina M. Mädge, Marco Landt-Hayen

6.4.2020